HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
#
[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
3ecaf7e5
RS		 27#ifdef HAVE_UNISTD_H
28#include <unistd.h>
29#endif
30
40e6f148 31/* This makes the fields of a Display accessible, in Xlib header files. */
333b20bb 32
40e6f148
RS		 33#define XLIB_ILLEGAL_ACCESS
34
01f1ba30
JB		 35#include "lisp.h"
36#include "xterm.h"
f676886a 37#include "frame.h"
01f1ba30
JB		 38#include "window.h"
39#include "buffer.h"
58cad5ed 40#include "intervals.h"
01f1ba30 41#include "dispextern.h"
1f98fa48 42#include "keyboard.h"
9ac0d9e0 43#include "blockinput.h"
57bda87a 44#include <epaths.h>
942ea06d 45#include "charset.h"
96db09e4 46#include "coding.h"
942ea06d 47#include "fontset.h"
333b20bb
GM		 48#include "systime.h"
49#include "termhooks.h"
4ae9a85e 50#include "atimer.h"
01f1ba30
JB		 51
52#ifdef HAVE_X_WINDOWS
67ba84d1 53
67ba84d1 54#include <ctype.h>
63cec32f
GM		 55#include <sys/types.h>
56#include <sys/stat.h>
01f1ba30 57
0a93081c 58#ifndef VMS
0505a740 59#if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
ef493a27
RS		 60#include "bitmaps/gray.xbm"
61#else
dbc4e1c1 62#include <X11/bitmaps/gray>
ef493a27 63#endif
0a93081c
JB		 64#else
65#include "[.bitmaps]gray.xbm"
66#endif
dbc4e1c1 67
9ef48a9d
RS		 68#ifdef USE_X_TOOLKIT
69#include <X11/Shell.h>
70
398ffa92 71#ifndef USE_MOTIF
9ef48a9d
RS		 72#include <X11/Xaw/Paned.h>
73#include <X11/Xaw/Label.h>
398ffa92 74#endif /* USE_MOTIF */
9ef48a9d
RS		 75
76#ifdef USG
77#undef USG /* ####KLUDGE for Solaris 2.2 and up */
78#include <X11/Xos.h>
79#define USG
80#else
81#include <X11/Xos.h>
82#endif
83
84#include "widget.h"
85
86#include "../lwlib/lwlib.h"
87
333b20bb
GM		 88#ifdef USE_MOTIF
89#include <Xm/Xm.h>
90#include <Xm/DialogS.h>
91#include <Xm/FileSB.h>
92#endif
93
3b882b1d
RS		 94/* Do the EDITRES protocol if running X11R5
95 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
333b20bb 96
3b882b1d 97#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
6c32dd68 98#define HACK_EDITRES
b9dc4443 99extern void _XEditResCheckMessages ();
6c32dd68
PR		 100#endif /* R5 + Athena */
101
333b20bb
GM		 102/* Unique id counter for widgets created by the Lucid Widget Library. */
103
6c32dd68
PR		 104extern LWLIB_ID widget_id_tick;
105
e3881aa0 106#ifdef USE_LUCID
82c90203 107/* This is part of a kludge--see lwlib/xlwmenu.c. */
03e2c340 108extern XFontStruct *xlwmenu_default_font;
e3881aa0 109#endif
9ef48a9d 110
6bc20398 111extern void free_frame_menubar ();
d62c8769 112extern double atof ();
333b20bb 113
fc2cdd9a
GM		 114#ifdef USE_MOTIF
115
116/* LessTif/Motif version info. */
117
118static Lisp_Object Vmotif_version_string;
119
120#endif /* USE_MOTIF */
121
9ef48a9d
RS		 122#endif /* USE_X_TOOLKIT */
123
9d317b2c
RS		 124#ifdef HAVE_X11R4
125#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
126#else
127#define MAXREQUEST(dpy) ((dpy)->max_request_size)
128#endif
129
333b20bb
GM		 130/* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
131 it, and including `bitmaps/gray' more than once is a problem when
132 config.h defines `static' as an empty replacement string. */
133
134int gray_bitmap_width = gray_width;
135int gray_bitmap_height = gray_height;
62906360 136char *gray_bitmap_bits = gray_bits;
333b20bb 137
498e9ac3 138/* The name we're using in resource queries. Most often "emacs". */
333b20bb 139
d387c960 140Lisp_Object Vx_resource_name;
ac63d3d6 141
498e9ac3
RS		 142/* The application class we're using in resource queries.
143 Normally "Emacs". */
333b20bb 144
498e9ac3
RS		 145Lisp_Object Vx_resource_class;
146
0af913d7 147/* Non-zero means we're allowed to display an hourglass cursor. */
333b20bb 148
0af913d7 149int display_hourglass_p;
333b20bb 150
01f1ba30 151/* The background and shape of the mouse pointer, and shape when not
b9dc4443 152 over text or in the modeline. */
333b20bb 153
01f1ba30 154Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 155Lisp_Object Vx_hourglass_pointer_shape;
333b20bb 156
ca0ecbf5 157/* The shape when over mouse-sensitive text. */
333b20bb 158
ca0ecbf5 159Lisp_Object Vx_sensitive_text_pointer_shape;
01f1ba30 160
8fb4ec9c
GM		 161/* If non-nil, the pointer shape to indicate that windows can be
162 dragged horizontally. */
163
164Lisp_Object Vx_window_horizontal_drag_shape;
165
b9dc4443 166/* Color of chars displayed in cursor box. */
333b20bb 167
01f1ba30
JB		 168Lisp_Object Vx_cursor_fore_pixel;
169
b9dc4443 170/* Nonzero if using X. */
333b20bb 171
b9dc4443 172static int x_in_use;
01f1ba30 173
b9dc4443 174/* Non nil if no window manager is in use. */
333b20bb 175
01f1ba30
JB		 176Lisp_Object Vx_no_window_manager;
177
f1c7b5a6 178/* Search path for bitmap files. */
333b20bb 179
f1c7b5a6
RS		 180Lisp_Object Vx_bitmap_file_path;
181
942ea06d 182/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
333b20bb 183
942ea06d
KH		 184Lisp_Object Vx_pixel_size_width_font_regexp;
185
f9942c9e
JB		 186Lisp_Object Qauto_raise;
187Lisp_Object Qauto_lower;
dbc4e1c1 188Lisp_Object Qbar;
f9942c9e
JB		 189Lisp_Object Qborder_color;
190Lisp_Object Qborder_width;
dbc4e1c1 191Lisp_Object Qbox;
f9942c9e 192Lisp_Object Qcursor_color;
dbc4e1c1 193Lisp_Object Qcursor_type;
f9942c9e 194Lisp_Object Qgeometry;
f9942c9e
JB		 195Lisp_Object Qicon_left;
196Lisp_Object Qicon_top;
197Lisp_Object Qicon_type;
80534dd6 198Lisp_Object Qicon_name;
f9942c9e
JB		 199Lisp_Object Qinternal_border_width;
200Lisp_Object Qleft;
1ab3d87e 201Lisp_Object Qright;
f9942c9e 202Lisp_Object Qmouse_color;
baaed68e 203Lisp_Object Qnone;
2cbebefb 204Lisp_Object Qouter_window_id;
f9942c9e 205Lisp_Object Qparent_id;
4701395c 206Lisp_Object Qscroll_bar_width;
8af1d7ca 207Lisp_Object Qsuppress_icon;
333b20bb 208extern Lisp_Object Qtop;
01f1ba30 209Lisp_Object Qundefined_color;
a3c87d4e 210Lisp_Object Qvertical_scroll_bars;
49795535 211Lisp_Object Qvisibility;
f9942c9e 212Lisp_Object Qwindow_id;
f676886a 213Lisp_Object Qx_frame_parameter;
9ef48a9d 214Lisp_Object Qx_resource_name;
4fe1de12
RS		 215Lisp_Object Quser_position;
216Lisp_Object Quser_size;
0cafb359 217extern Lisp_Object Qdisplay;
333b20bb 218Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
7c7ff7f5 219Lisp_Object Qscreen_gamma, Qline_spacing, Qcenter;
ae782866 220Lisp_Object Qcompound_text, Qcancel_timer;
ea0a1f53 221Lisp_Object Qwait_for_wm;
49d41073
EZ		 222Lisp_Object Qfullscreen;
223Lisp_Object Qfullwidth;
224Lisp_Object Qfullheight;
225Lisp_Object Qfullboth;
01f1ba30 226
b9dc4443 227/* The below are defined in frame.c. */
333b20bb 228
baaed68e 229extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
c2304e02 230extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
9ea173e8 231extern Lisp_Object Qtool_bar_lines;
f9942c9e 232
01f1ba30
JB		 233extern Lisp_Object Vwindow_system_version;
234
a367641f 235Lisp_Object Qface_set_after_frame_default;
333b20bb 236
f1d2ce7f 237#if GLYPH_DEBUG
eaf1eea9
GM		 238int image_cache_refcount, dpyinfo_refcount;
239#endif
240
241
01f1ba30 242\f
11ae94fe 243/* Error if we are not connected to X. */
333b20bb 244
7fc9de26 245void
11ae94fe
RS		 246check_x ()
247{
b9dc4443 248 if (! x_in_use)
11ae94fe
RS		 249 error ("X windows are not in use or not initialized");
250}
251
1c59f5df
RS		 252/* Nonzero if we can use mouse menus.
253 You should not call this unless HAVE_MENUS is defined. */
75cc8ee5
RS		 254
255int
1c59f5df 256have_menus_p ()
75cc8ee5 257{
b9dc4443
RS		 258 return x_in_use;
259}
260
261/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
262 and checking validity for X. */
263
264FRAME_PTR
265check_x_frame (frame)
266 Lisp_Object frame;
267{
268 FRAME_PTR f;
269
270 if (NILP (frame))
0fe92f72 271 frame = selected_frame;
b7826503 272 CHECK_LIVE_FRAME (frame);
0fe92f72 273 f = XFRAME (frame);
b9dc4443 274 if (! FRAME_X_P (f))
1c59f5df 275 error ("Non-X frame used");
b9dc4443 276 return f;
75cc8ee5
RS		 277}
278
b9dc4443
RS		 279/* Let the user specify an X display with a frame.
280 nil stands for the selected frame--or, if that is not an X frame,
281 the first X display on the list. */
282
283static struct x_display_info *
284check_x_display_info (frame)
285 Lisp_Object frame;
286{
8ec8a5ec
GM		 287 struct x_display_info *dpyinfo = NULL;
288
b9dc4443
RS		 289 if (NILP (frame))
290 {
0fe92f72
GM		 291 struct frame *sf = XFRAME (selected_frame);
292
293 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
8ec8a5ec 294 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
b9dc4443 295 else if (x_display_list != 0)
8ec8a5ec 296 dpyinfo = x_display_list;
b9dc4443
RS		 297 else
298 error ("X windows are not in use or not initialized");
299 }
300 else if (STRINGP (frame))
8ec8a5ec 301 dpyinfo = x_display_info_for_name (frame);
b9dc4443
RS		 302 else
303 {
304 FRAME_PTR f;
305
b7826503 306 CHECK_LIVE_FRAME (frame);
b9dc4443
RS		 307 f = XFRAME (frame);
308 if (! FRAME_X_P (f))
1c59f5df 309 error ("Non-X frame used");
8ec8a5ec 310 dpyinfo = FRAME_X_DISPLAY_INFO (f);
b9dc4443 311 }
8ec8a5ec
GM		 312
313 return dpyinfo;
b9dc4443 314}
333b20bb 315
b9dc4443 316\f
f676886a
JB		 317/* Return the Emacs frame-object corresponding to an X window.
318 It could be the frame's main window or an icon window. */
01f1ba30 319
34ca5317 320/* This function can be called during GC, so use GC_xxx type test macros. */
bcb2db92 321
f676886a 322struct frame *
2d271e2e
KH		 323x_window_to_frame (dpyinfo, wdesc)
324 struct x_display_info *dpyinfo;
01f1ba30
JB		 325 int wdesc;
326{
f676886a
JB		 327 Lisp_Object tail, frame;
328 struct frame *f;
01f1ba30 329
8e713be6 330 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
01f1ba30 331 {
8e713be6 332 frame = XCAR (tail);
34ca5317 333 if (!GC_FRAMEP (frame))
01f1ba30 334 continue;
f676886a 335 f = XFRAME (frame);
2d764c78 336 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
2d271e2e 337 continue;
0af913d7 338 if (f->output_data.x->hourglass_window == wdesc)
17cbbf95 339 return f;
9ef48a9d 340#ifdef USE_X_TOOLKIT
7556890b
RS		 341 if ((f->output_data.x->edit_widget
342 && XtWindow (f->output_data.x->edit_widget) == wdesc)
333b20bb
GM		 343 /* A tooltip frame? */
344 || (!f->output_data.x->edit_widget
345 && FRAME_X_WINDOW (f) == wdesc)
7556890b 346 || f->output_data.x->icon_desc == wdesc)
9ef48a9d
RS		 347 return f;
348#else /* not USE_X_TOOLKIT */
fe24a618 349 if (FRAME_X_WINDOW (f) == wdesc
7556890b 350 || f->output_data.x->icon_desc == wdesc)
f676886a 351 return f;
9ef48a9d
RS		 352#endif /* not USE_X_TOOLKIT */
353 }
354 return 0;
355}
356
357#ifdef USE_X_TOOLKIT
358/* Like x_window_to_frame but also compares the window with the widget's
359 windows. */
360
361struct frame *
2d271e2e
KH		 362x_any_window_to_frame (dpyinfo, wdesc)
363 struct x_display_info *dpyinfo;
9ef48a9d
RS		 364 int wdesc;
365{
366 Lisp_Object tail, frame;
17cbbf95 367 struct frame *f, *found;
7556890b 368 struct x_output *x;
9ef48a9d 369
17cbbf95
GM		 370 found = NULL;
371 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
9ef48a9d 372 {
8e713be6 373 frame = XCAR (tail);
34ca5317 374 if (!GC_FRAMEP (frame))
9ef48a9d 375 continue;
17cbbf95 376
9ef48a9d 377 f = XFRAME (frame);
17cbbf95 378 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
333b20bb 379 {
17cbbf95
GM		 380 /* This frame matches if the window is any of its widgets. */
381 x = f->output_data.x;
0af913d7 382 if (x->hourglass_window == wdesc)
17cbbf95
GM		 383 found = f;
384 else if (x->widget)
385 {
386 if (wdesc == XtWindow (x->widget)
387 || wdesc == XtWindow (x->column_widget)
388 || wdesc == XtWindow (x->edit_widget))
389 found = f;
390 /* Match if the window is this frame's menubar. */
391 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
392 found = f;
393 }
394 else if (FRAME_X_WINDOW (f) == wdesc)
395 /* A tooltip frame. */
396 found = f;
333b20bb 397 }
01f1ba30 398 }
17cbbf95
GM		 399
400 return found;
01f1ba30 401}
5e65b9ab 402
5fbc3f3a
KH		 403/* Likewise, but exclude the menu bar widget. */
404
405struct frame *
406x_non_menubar_window_to_frame (dpyinfo, wdesc)
407 struct x_display_info *dpyinfo;
408 int wdesc;
409{
410 Lisp_Object tail, frame;
411 struct frame *f;
7556890b 412 struct x_output *x;
5fbc3f3a 413
8e713be6 414 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
5fbc3f3a 415 {
8e713be6 416 frame = XCAR (tail);
5fbc3f3a
KH		 417 if (!GC_FRAMEP (frame))
418 continue;
419 f = XFRAME (frame);
2d764c78 420 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
5fbc3f3a 421 continue;
7556890b 422 x = f->output_data.x;
5fbc3f3a 423 /* This frame matches if the window is any of its widgets. */
0af913d7 424 if (x->hourglass_window == wdesc)
17cbbf95
GM		 425 return f;
426 else if (x->widget)
333b20bb
GM		 427 {
428 if (wdesc == XtWindow (x->widget)
429 || wdesc == XtWindow (x->column_widget)
430 || wdesc == XtWindow (x->edit_widget))
431 return f;
432 }
433 else if (FRAME_X_WINDOW (f) == wdesc)
434 /* A tooltip frame. */
5fbc3f3a
KH		 435 return f;
436 }
437 return 0;
438}
439
fd3a3022
RS		 440/* Likewise, but consider only the menu bar widget. */
441
442struct frame *
443x_menubar_window_to_frame (dpyinfo, wdesc)
444 struct x_display_info *dpyinfo;
445 int wdesc;
446{
447 Lisp_Object tail, frame;
448 struct frame *f;
7556890b 449 struct x_output *x;
fd3a3022 450
8e713be6 451 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
fd3a3022 452 {
8e713be6 453 frame = XCAR (tail);
fd3a3022
RS		 454 if (!GC_FRAMEP (frame))
455 continue;
456 f = XFRAME (frame);
2d764c78 457 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
fd3a3022 458 continue;
7556890b 459 x = f->output_data.x;
fd3a3022 460 /* Match if the window is this frame's menubar. */
333b20bb
GM		 461 if (x->menubar_widget
462 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
fd3a3022
RS		 463 return f;
464 }
465 return 0;
466}
467
5e65b9ab
RS		 468/* Return the frame whose principal (outermost) window is WDESC.
469 If WDESC is some other (smaller) window, we return 0. */
470
471struct frame *
2d271e2e
KH		 472x_top_window_to_frame (dpyinfo, wdesc)
473 struct x_display_info *dpyinfo;
5e65b9ab
RS		 474 int wdesc;
475{
476 Lisp_Object tail, frame;
477 struct frame *f;
7556890b 478 struct x_output *x;
5e65b9ab 479
8e713be6 480 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
5e65b9ab 481 {
8e713be6 482 frame = XCAR (tail);
34ca5317 483 if (!GC_FRAMEP (frame))
5e65b9ab
RS		 484 continue;
485 f = XFRAME (frame);
2d764c78 486 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
2d271e2e 487 continue;
7556890b 488 x = f->output_data.x;
333b20bb
GM		 489
490 if (x->widget)
491 {
492 /* This frame matches if the window is its topmost widget. */
493 if (wdesc == XtWindow (x->widget))
494 return f;
7a994728
KH		 495#if 0 /* I don't know why it did this,
496 but it seems logically wrong,
497 and it causes trouble for MapNotify events. */
333b20bb
GM		 498 /* Match if the window is this frame's menubar. */
499 if (x->menubar_widget
500 && wdesc == XtWindow (x->menubar_widget))
501 return f;
7a994728 502#endif
333b20bb
GM		 503 }
504 else if (FRAME_X_WINDOW (f) == wdesc)
505 /* Tooltip frame. */
506 return f;
5e65b9ab
RS		 507 }
508 return 0;
509}
9ef48a9d 510#endif /* USE_X_TOOLKIT */
01f1ba30 511
01f1ba30 512\f
203c1d73
RS		 513
514/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
515 id, which is just an int that this section returns. Bitmaps are
516 reference counted so they can be shared among frames.
517
518 Bitmap indices are guaranteed to be > 0, so a negative number can
519 be used to indicate no bitmap.
520
521 If you use x_create_bitmap_from_data, then you must keep track of
522 the bitmaps yourself. That is, creating a bitmap from the same
b9dc4443 523 data more than once will not be caught. */
203c1d73
RS		 524
525
f1c7b5a6
RS		 526/* Functions to access the contents of a bitmap, given an id. */
527
528int
529x_bitmap_height (f, id)
530 FRAME_PTR f;
531 int id;
532{
08a90d6a 533 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
f1c7b5a6
RS		 534}
535
536int
537x_bitmap_width (f, id)
538 FRAME_PTR f;
539 int id;
540{
08a90d6a 541 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
f1c7b5a6
RS		 542}
543
544int
545x_bitmap_pixmap (f, id)
546 FRAME_PTR f;
547 int id;
548{
08a90d6a 549 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
f1c7b5a6
RS		 550}
551
552
203c1d73
RS		 553/* Allocate a new bitmap record. Returns index of new record. */
554
555static int
08a90d6a
RS		 556x_allocate_bitmap_record (f)
557 FRAME_PTR f;
203c1d73 558{
08a90d6a
RS		 559 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
560 int i;
561
562 if (dpyinfo->bitmaps == NULL)
203c1d73 563 {
08a90d6a
RS		 564 dpyinfo->bitmaps_size = 10;
565 dpyinfo->bitmaps
566 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
567 dpyinfo->bitmaps_last = 1;
203c1d73
RS		 568 return 1;
569 }
570
08a90d6a
RS		 571 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
572 return ++dpyinfo->bitmaps_last;
203c1d73 573
08a90d6a
RS		 574 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
575 if (dpyinfo->bitmaps[i].refcount == 0)
576 return i + 1;
203c1d73 577
08a90d6a
RS		 578 dpyinfo->bitmaps_size *= 2;
579 dpyinfo->bitmaps
580 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
581 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
582 return ++dpyinfo->bitmaps_last;
203c1d73
RS		 583}
584
585/* Add one reference to the reference count of the bitmap with id ID. */
586
587void
f1c7b5a6
RS		 588x_reference_bitmap (f, id)
589 FRAME_PTR f;
203c1d73
RS		 590 int id;
591{
08a90d6a 592 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
203c1d73
RS		 593}
594
595/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
596
597int
598x_create_bitmap_from_data (f, bits, width, height)
599 struct frame *f;
600 char *bits;
601 unsigned int width, height;
602{
08a90d6a 603 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
203c1d73
RS		 604 Pixmap bitmap;
605 int id;
606
b9dc4443 607 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
203c1d73
RS		 608 bits, width, height);
609
610 if (! bitmap)
611 return -1;
612
08a90d6a
RS		 613 id = x_allocate_bitmap_record (f);
614 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
615 dpyinfo->bitmaps[id - 1].file = NULL;
616 dpyinfo->bitmaps[id - 1].refcount = 1;
617 dpyinfo->bitmaps[id - 1].depth = 1;
618 dpyinfo->bitmaps[id - 1].height = height;
619 dpyinfo->bitmaps[id - 1].width = width;
203c1d73
RS		 620
621 return id;
622}
623
624/* Create bitmap from file FILE for frame F. */
625
626int
627x_create_bitmap_from_file (f, file)
628 struct frame *f;
f1c7b5a6 629 Lisp_Object file;
203c1d73 630{
08a90d6a 631 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
203c1d73
RS		 632 unsigned int width, height;
633 Pixmap bitmap;
634 int xhot, yhot, result, id;
f1c7b5a6
RS		 635 Lisp_Object found;
636 int fd;
637 char *filename;
203c1d73
RS		 638
639 /* Look for an existing bitmap with the same name. */
08a90d6a 640 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
203c1d73 641 {
08a90d6a
RS		 642 if (dpyinfo->bitmaps[id].refcount
643 && dpyinfo->bitmaps[id].file
644 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
203c1d73 645 {
08a90d6a 646 ++dpyinfo->bitmaps[id].refcount;
203c1d73
RS		 647 return id + 1;
648 }
649 }
650
f1c7b5a6 651 /* Search bitmap-file-path for the file, if appropriate. */
c0ec53ad 652 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
f1c7b5a6
RS		 653 if (fd < 0)
654 return -1;
68c45bf0 655 emacs_close (fd);
f1c7b5a6
RS		 656
657 filename = (char *) XSTRING (found)->data;
658
b9dc4443 659 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f1c7b5a6 660 filename, &width, &height, &bitmap, &xhot, &yhot);
203c1d73
RS		 661 if (result != BitmapSuccess)
662 return -1;
663
08a90d6a
RS		 664 id = x_allocate_bitmap_record (f);
665 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
666 dpyinfo->bitmaps[id - 1].refcount = 1;
9f2a85b2 667 dpyinfo->bitmaps[id - 1].file
fc932ac6 668 = (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
08a90d6a
RS		 669 dpyinfo->bitmaps[id - 1].depth = 1;
670 dpyinfo->bitmaps[id - 1].height = height;
671 dpyinfo->bitmaps[id - 1].width = width;
672 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
203c1d73
RS		 673
674 return id;
675}
676
677/* Remove reference to bitmap with id number ID. */
678
968b1234 679void
f1c7b5a6
RS		 680x_destroy_bitmap (f, id)
681 FRAME_PTR f;
203c1d73
RS		 682 int id;
683{
08a90d6a
RS		 684 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
685
203c1d73
RS		 686 if (id > 0)
687 {
08a90d6a
RS		 688 --dpyinfo->bitmaps[id - 1].refcount;
689 if (dpyinfo->bitmaps[id - 1].refcount == 0)
203c1d73 690 {
ed662bdd 691 BLOCK_INPUT;
08a90d6a
RS		 692 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
693 if (dpyinfo->bitmaps[id - 1].file)
203c1d73 694 {
333b20bb 695 xfree (dpyinfo->bitmaps[id - 1].file);
08a90d6a 696 dpyinfo->bitmaps[id - 1].file = NULL;
203c1d73 697 }
ed662bdd 698 UNBLOCK_INPUT;
203c1d73
RS		 699 }
700 }
701}
702
08a90d6a 703/* Free all the bitmaps for the display specified by DPYINFO. */
203c1d73 704
08a90d6a
RS		 705static void
706x_destroy_all_bitmaps (dpyinfo)
707 struct x_display_info *dpyinfo;
203c1d73 708{
08a90d6a
RS		 709 int i;
710 for (i = 0; i < dpyinfo->bitmaps_last; i++)
711 if (dpyinfo->bitmaps[i].refcount > 0)
712 {
713 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
714 if (dpyinfo->bitmaps[i].file)
333b20bb 715 xfree (dpyinfo->bitmaps[i].file);
08a90d6a
RS		 716 }
717 dpyinfo->bitmaps_last = 0;
203c1d73
RS		 718}
719\f
f676886a 720/* Connect the frame-parameter names for X frames
01f1ba30
JB		 721 to the ways of passing the parameter values to the window system.
722
723 The name of a parameter, as a Lisp symbol,
f676886a 724 has an `x-frame-parameter' property which is an integer in Lisp
9fb026ab 725 that is an index in this table. */
01f1ba30 726
f676886a 727struct x_frame_parm_table
01f1ba30
JB		 728{
729 char *name;
d62c8769 730 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
01f1ba30
JB		 731};
732
eaf1eea9
GM		 733static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
734static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
52de7ce9 735static void x_change_window_heights P_ ((Lisp_Object, int));
14819cb3 736static void x_disable_image P_ ((struct frame *, struct image *));
d62c8769 737void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
563b67aa 738static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
ea0a1f53 739static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
49d41073 740static void x_set_fullscreen P_ ((struct frame *, Lisp_Object, Lisp_Object));
d62c8769
GM		 741void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
742void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
743void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
744void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
745void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
746void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
747void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
b3ba0aa8 748static void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
d62c8769
GM		 749void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
750void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
751void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
752 Lisp_Object));
753void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
754void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
755void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
756void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
757 Lisp_Object));
758void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
759void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
760void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
761void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
762void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
9ea173e8 763void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
333b20bb
GM		 764void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
765 Lisp_Object));
766void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
767 Lisp_Object));
768static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
769 Lisp_Object,
770 Lisp_Object,
771 char *, char *,
772 int));
d62c8769 773static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
4a8e312c
GM		 774static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
775 Lisp_Object));
b243755a
GM		 776static void init_color_table P_ ((void));
777static void free_color_table P_ ((void));
778static unsigned long *colors_in_color_table P_ ((int *n));
779static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
780static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
781
782
01f1ba30 783
f676886a 784static struct x_frame_parm_table x_frame_parms[] =
01f1ba30 785{
9908a324
PJ		 786 {"auto-raise", x_set_autoraise},
787 {"auto-lower", x_set_autolower},
788 {"background-color", x_set_background_color},
789 {"border-color", x_set_border_color},
790 {"border-width", x_set_border_width},
791 {"cursor-color", x_set_cursor_color},
792 {"cursor-type", x_set_cursor_type},
793 {"font", x_set_font},
794 {"foreground-color", x_set_foreground_color},
795 {"icon-name", x_set_icon_name},
796 {"icon-type", x_set_icon_type},
797 {"internal-border-width", x_set_internal_border_width},
798 {"menu-bar-lines", x_set_menu_bar_lines},
799 {"mouse-color", x_set_mouse_color},
800 {"name", x_explicitly_set_name},
801 {"scroll-bar-width", x_set_scroll_bar_width},
802 {"title", x_set_title},
803 {"unsplittable", x_set_unsplittable},
804 {"vertical-scroll-bars", x_set_vertical_scroll_bars},
805 {"visibility", x_set_visibility},
806 {"tool-bar-lines", x_set_tool_bar_lines},
807 {"scroll-bar-foreground", x_set_scroll_bar_foreground},
808 {"scroll-bar-background", x_set_scroll_bar_background},
809 {"screen-gamma", x_set_screen_gamma},
810 {"line-spacing", x_set_line_spacing},
811 {"left-fringe", x_set_fringe_width},
812 {"right-fringe", x_set_fringe_width},
49d41073
EZ		 813 {"wait-for-wm", x_set_wait_for_wm},
814 {"fullscreen", x_set_fullscreen},
815
01f1ba30
JB		 816};
817
f676886a 818/* Attach the `x-frame-parameter' properties to
01f1ba30
JB		 819 the Lisp symbol names of parameters relevant to X. */
820
201d8c78 821void
01f1ba30
JB		 822init_x_parm_symbols ()
823{
824 int i;
825
d043f1a4 826 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
f676886a 827 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
01f1ba30
JB		 828 make_number (i));
829}
830\f
49d41073
EZ		 831
832/* Really try to move where we want to be in case of fullscreen. Some WMs
833 moves the window where we tell them. Some (mwm, twm) moves the outer
834 window manager window there instead.
835 Try to compensate for those WM here. */
836static void
837x_fullscreen_move (f, new_top, new_left)
838 struct frame *f;
839 int new_top;
840 int new_left;
841{
842 if (new_top != f->output_data.x->top_pos
843 || new_left != f->output_data.x->left_pos)
844 {
845 int move_x = new_left + f->output_data.x->x_pixels_outer_diff;
846 int move_y = new_top + f->output_data.x->y_pixels_outer_diff;
847
848 f->output_data.x->want_fullscreen |= FULLSCREEN_MOVE_WAIT;
849 x_set_offset (f, move_x, move_y, 1);
850 }
851}
852
e8cc313b 853/* Change the parameters of frame F as specified by ALIST.
64362cd4
GM		 854 If a parameter is not specially recognized, do nothing special;
855 otherwise call the `x_set_...' function for that parameter.
856 Except for certain geometry properties, always call store_frame_param
857 to store the new value in the parameter alist. */
d043f1a4 858
f9942c9e
JB		 859void
860x_set_frame_parameters (f, alist)
861 FRAME_PTR f;
862 Lisp_Object alist;
863{
864 Lisp_Object tail;
865
866 /* If both of these parameters are present, it's more efficient to
867 set them both at once. So we wait until we've looked at the
868 entire list before we set them. */
e4f79258 869 int width, height;
f9942c9e
JB		 870
871 /* Same here. */
872 Lisp_Object left, top;
f9942c9e 873
a59e4f3d
RS		 874 /* Same with these. */
875 Lisp_Object icon_left, icon_top;
876
f5e70acd
RS		 877 /* Record in these vectors all the parms specified. */
878 Lisp_Object *parms;
879 Lisp_Object *values;
a797a73d 880 int i, p;
e1d962d7 881 int left_no_change = 0, top_no_change = 0;
a59e4f3d 882 int icon_left_no_change = 0, icon_top_no_change = 0;
5f9338d5 883 int fullscreen_is_being_set = 0;
203c1d73 884
7589a1d9
RS		 885 struct gcpro gcpro1, gcpro2;
886
f5e70acd
RS		 887 i = 0;
888 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
889 i++;
890
891 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
892 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
f9942c9e 893
f5e70acd
RS		 894 /* Extract parm names and values into those vectors. */
895
896 i = 0;
f9942c9e
JB		 897 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
898 {
333b20bb 899 Lisp_Object elt;
f9942c9e
JB		 900
901 elt = Fcar (tail);
f5e70acd
RS		 902 parms[i] = Fcar (elt);
903 values[i] = Fcdr (elt);
904 i++;
905 }
7589a1d9
RS		 906 /* TAIL and ALIST are not used again below here. */
907 alist = tail = Qnil;
908
909 GCPRO2 (*parms, *values);
910 gcpro1.nvars = i;
911 gcpro2.nvars = i;
f5e70acd 912
7589a1d9
RS		 913 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
914 because their values appear in VALUES and strings are not valid. */
e4f79258 915 top = left = Qunbound;
a59e4f3d 916 icon_left = icon_top = Qunbound;
f9942c9e 917
e4f79258
RS		 918 /* Provide default values for HEIGHT and WIDTH. */
919 if (FRAME_NEW_WIDTH (f))
920 width = FRAME_NEW_WIDTH (f);
921 else
922 width = FRAME_WIDTH (f);
923
924 if (FRAME_NEW_HEIGHT (f))
925 height = FRAME_NEW_HEIGHT (f);
926 else
927 height = FRAME_HEIGHT (f);
928
a797a73d
GV		 929 /* Process foreground_color and background_color before anything else.
930 They are independent of other properties, but other properties (e.g.,
931 cursor_color) are dependent upon them. */
b3ba0aa8 932 /* Process default font as well, since fringe widths depends on it. */
49d41073 933 /* Also, process fullscreen, width and height depend upon that */
a797a73d
GV		 934 for (p = 0; p < i; p++)
935 {
936 Lisp_Object prop, val;
937
938 prop = parms[p];
939 val = values[p];
b3ba0aa8
KS		 940 if (EQ (prop, Qforeground_color)
941 || EQ (prop, Qbackground_color)
49d41073
EZ		 942 || EQ (prop, Qfont)
943 || EQ (prop, Qfullscreen))
a797a73d
GV		 944 {
945 register Lisp_Object param_index, old_value;
946
a797a73d 947 old_value = get_frame_param (f, prop);
f0b9a067 948 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
c7e609d5
MB		 949
950 if (NILP (Fequal (val, old_value)))
951 {
952 store_frame_param (f, prop, val);
953
954 param_index = Fget (prop, Qx_frame_parameter);
955 if (NATNUMP (param_index)
956 && (XFASTINT (param_index)
957 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
958 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
959 }
a797a73d
GV		 960 }
961 }
962
f5e70acd
RS		 963 /* Now process them in reverse of specified order. */
964 for (i--; i >= 0; i--)
965 {
966 Lisp_Object prop, val;
967
968 prop = parms[i];
969 val = values[i];
970
e4f79258
RS		 971 if (EQ (prop, Qwidth) && NUMBERP (val))
972 width = XFASTINT (val);
973 else if (EQ (prop, Qheight) && NUMBERP (val))
974 height = XFASTINT (val);
f5e70acd 975 else if (EQ (prop, Qtop))
f9942c9e 976 top = val;
f5e70acd 977 else if (EQ (prop, Qleft))
f9942c9e 978 left = val;
a59e4f3d
RS		 979 else if (EQ (prop, Qicon_top))
980 icon_top = val;
981 else if (EQ (prop, Qicon_left))
982 icon_left = val;
b3ba0aa8
KS		 983 else if (EQ (prop, Qforeground_color)
984 || EQ (prop, Qbackground_color)
49d41073
EZ		 985 || EQ (prop, Qfont)
986 || EQ (prop, Qfullscreen))
a797a73d
GV		 987 /* Processed above. */
988 continue;
f9942c9e
JB		 989 else
990 {
98381190 991 register Lisp_Object param_index, old_value;
ea96210c 992
98381190 993 old_value = get_frame_param (f, prop);
c7e609d5 994
9f7e52b4 995 store_frame_param (f, prop, val);
c7e609d5 996
9f7e52b4
GM		 997 param_index = Fget (prop, Qx_frame_parameter);
998 if (NATNUMP (param_index)
999 && (XFASTINT (param_index)
1000 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
1001 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
f9942c9e
JB		 1002 }
1003 }
1004
11378c41
RS		 1005 /* Don't die if just one of these was set. */
1006 if (EQ (left, Qunbound))
e1d962d7
RS		 1007 {
1008 left_no_change = 1;
7556890b
RS		 1009 if (f->output_data.x->left_pos < 0)
1010 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
e1d962d7 1011 else
7556890b 1012 XSETINT (left, f->output_data.x->left_pos);
e1d962d7 1013 }
11378c41 1014 if (EQ (top, Qunbound))
e1d962d7
RS		 1015 {
1016 top_no_change = 1;
7556890b
RS		 1017 if (f->output_data.x->top_pos < 0)
1018 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
e1d962d7 1019 else
7556890b 1020 XSETINT (top, f->output_data.x->top_pos);
e1d962d7 1021 }
11378c41 1022
a59e4f3d
RS		 1023 /* If one of the icon positions was not set, preserve or default it. */
1024 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
1025 {
1026 icon_left_no_change = 1;
1027 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
1028 if (NILP (icon_left))
1029 XSETINT (icon_left, 0);
1030 }
1031 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
1032 {
1033 icon_top_no_change = 1;
1034 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
1035 if (NILP (icon_top))
1036 XSETINT (icon_top, 0);
1037 }
1038
5f9338d5 1039 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
49d41073
EZ		 1040 {
1041 /* If the frame is visible already and the fullscreen parameter is
1042 being set, it is too late to set WM manager hints to specify
1043 size and position.
1044 Here we first get the width, height and position that applies to
1045 fullscreen. We then move the frame to the appropriate
1046 position. Resize of the frame is taken care of in the code after
5f9338d5 1047 this if-statement. */
49d41073
EZ		 1048 int new_left, new_top;
1049
1050 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
1051 x_fullscreen_move (f, new_top, new_left);
1052 }
1053
499ea23b 1054 /* Don't set these parameters unless they've been explicitly
d387c960
JB		 1055 specified. The window might be mapped or resized while we're in
1056 this function, and we don't want to override that unless the lisp
1057 code has asked for it.
1058
1059 Don't set these parameters unless they actually differ from the
1060 window's current parameters; the window may not actually exist
1061 yet. */
f9942c9e
JB		 1062 {
1063 Lisp_Object frame;
1064
1f11a5ca
RS		 1065 check_frame_size (f, &height, &width);
1066
191ed777 1067 XSETFRAME (frame, f);
11378c41 1068
e4f79258
RS		 1069 if (width != FRAME_WIDTH (f)
1070 || height != FRAME_HEIGHT (f)
d6f80ae9 1071 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
e4f79258 1072 Fset_frame_size (frame, make_number (width), make_number (height));
f10f0b79
RS		 1073
1074 if ((!NILP (left) || !NILP (top))
e1d962d7 1075 && ! (left_no_change && top_no_change)
7556890b
RS		 1076 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
1077 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
f10f0b79 1078 {
e1d962d7
RS		 1079 int leftpos = 0;
1080 int toppos = 0;
f10f0b79
RS		 1081
1082 /* Record the signs. */
7556890b 1083 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
e1d962d7 1084 if (EQ (left, Qminus))
7556890b 1085 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7
RS		 1086 else if (INTEGERP (left))
1087 {
1088 leftpos = XINT (left);
1089 if (leftpos < 0)
7556890b 1090 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7 1091 }
8e713be6
KR		 1092 else if (CONSP (left) && EQ (XCAR (left), Qminus)
1093 && CONSP (XCDR (left))
1094 && INTEGERP (XCAR (XCDR (left))))
e1d962d7 1095 {
8e713be6 1096 leftpos = - XINT (XCAR (XCDR (left)));
7556890b 1097 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7 1098 }
8e713be6
KR		 1099 else if (CONSP (left) && EQ (XCAR (left), Qplus)
1100 && CONSP (XCDR (left))
1101 && INTEGERP (XCAR (XCDR (left))))
e1d962d7 1102 {
8e713be6 1103 leftpos = XINT (XCAR (XCDR (left)));
e1d962d7
RS		 1104 }
1105
1106 if (EQ (top, Qminus))
7556890b 1107 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7
RS		 1108 else if (INTEGERP (top))
1109 {
1110 toppos = XINT (top);
1111 if (toppos < 0)
7556890b 1112 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7 1113 }
8e713be6
KR		 1114 else if (CONSP (top) && EQ (XCAR (top), Qminus)
1115 && CONSP (XCDR (top))
1116 && INTEGERP (XCAR (XCDR (top))))
e1d962d7 1117 {
8e713be6 1118 toppos = - XINT (XCAR (XCDR (top)));
7556890b 1119 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7 1120 }
8e713be6
KR		 1121 else if (CONSP (top) && EQ (XCAR (top), Qplus)
1122 && CONSP (XCDR (top))
1123 && INTEGERP (XCAR (XCDR (top))))
e1d962d7 1124 {
8e713be6 1125 toppos = XINT (XCAR (XCDR (top)));
e1d962d7
RS		 1126 }
1127
1128
1129 /* Store the numeric value of the position. */
7556890b
RS		 1130 f->output_data.x->top_pos = toppos;
1131 f->output_data.x->left_pos = leftpos;
e1d962d7 1132
7556890b 1133 f->output_data.x->win_gravity = NorthWestGravity;
f10f0b79
RS		 1134
1135 /* Actually set that position, and convert to absolute. */
f0e72e79 1136 x_set_offset (f, leftpos, toppos, -1);
f10f0b79 1137 }
a59e4f3d
RS		 1138
1139 if ((!NILP (icon_left) || !NILP (icon_top))
1140 && ! (icon_left_no_change && icon_top_no_change))
1141 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
f9942c9e 1142 }
7589a1d9
RS		 1143
1144 UNGCPRO;
f9942c9e 1145}
01f1ba30 1146
08a90d6a 1147/* Store the screen positions of frame F into XPTR and YPTR.
e9445337
RS		 1148 These are the positions of the containing window manager window,
1149 not Emacs's own window. */
1150
1151void
1152x_real_positions (f, xptr, yptr)
1153 FRAME_PTR f;
1154 int *xptr, *yptr;
1155{
49d41073
EZ		 1156 int win_x, win_y, outer_x, outer_y;
1157 int real_x = 0, real_y = 0;
1158 int had_errors = 0;
1159 Window win = f->output_data.x->parent_desc;
e9445337 1160
49d41073 1161 int count;
043835a3 1162
49d41073
EZ		 1163 BLOCK_INPUT;
1164
1165 count = x_catch_errors (FRAME_X_DISPLAY (f));
043835a3 1166
49d41073
EZ		 1167 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
1168 win = FRAME_OUTER_WINDOW (f);
1169
1170 /* This loop traverses up the containment tree until we hit the root
1171 window. Window managers may intersect many windows between our window
1172 and the root window. The window we find just before the root window
1173 should be the outer WM window. */
1174 for (;;)
e9445337 1175 {
49d41073
EZ		 1176 Window wm_window, rootw;
1177 Window *tmp_children;
1178 unsigned int tmp_nchildren;
ca7bac79 1179
49d41073
EZ		 1180 XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
1181 &wm_window, &tmp_children, &tmp_nchildren);
72dc3bc7 1182 XFree ((char *) tmp_children);
08a90d6a 1183
49d41073 1184 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
08a90d6a 1185
49d41073
EZ		 1186 if (wm_window == rootw || had_errors)
1187 break;
08a90d6a 1188
49d41073
EZ		 1189 win = wm_window;
1190 }
1191
1192 if (! had_errors)
1193 {
1194 int ign;
1195 Window child, rootw;
1196
1197 /* Get the real coordinates for the WM window upper left corner */
1198 XGetGeometry (FRAME_X_DISPLAY (f), win,
1199 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
1200
1201 /* Translate real coordinates to coordinates relative to our
1202 window. For our window, the upper left corner is 0, 0.
1203 Since the upper left corner of the WM window is outside
1204 our window, win_x and win_y will be negative:
1205
1206 ------------------ ---> x
1207 | title |
1208 | ----------------- v y
1209 | | our window
1210 */
8a07bba0 1211 XTranslateCoordinates (FRAME_X_DISPLAY (f),
e9445337 1212
8a07bba0 1213 /* From-window, to-window. */
8a07bba0 1214 FRAME_X_DISPLAY_INFO (f)->root_window,
49d41073 1215 FRAME_X_WINDOW (f),
e9445337 1216
8a07bba0 1217 /* From-position, to-position. */
49d41073 1218 real_x, real_y, &win_x, &win_y,
08a90d6a 1219
8a07bba0
RS		 1220 /* Child of win. */
1221 &child);
e9445337 1222
49d41073 1223 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
845e9d85 1224 {
49d41073
EZ		 1225 outer_x = win_x;
1226 outer_y = win_y;
845e9d85 1227 }
49d41073
EZ		 1228 else
1229 {
1230 XTranslateCoordinates (FRAME_X_DISPLAY (f),
ca7bac79 1231
49d41073
EZ		 1232 /* From-window, to-window. */
1233 FRAME_X_DISPLAY_INFO (f)->root_window,
1234 FRAME_OUTER_WINDOW (f),
1235
1236 /* From-position, to-position. */
1237 real_x, real_y, &outer_x, &outer_y,
1238
1239 /* Child of win. */
1240 &child);
e9445337 1241 }
08a90d6a 1242
49d41073
EZ		 1243 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
1244 }
1245
1246 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1247
1248 UNBLOCK_INPUT;
1249
1250 if (had_errors) return;
1251
1252 f->output_data.x->x_pixels_diff = -win_x;
1253 f->output_data.x->y_pixels_diff = -win_y;
1254 f->output_data.x->x_pixels_outer_diff = -outer_x;
1255 f->output_data.x->y_pixels_outer_diff = -outer_y;
1256
1257 *xptr = real_x;
1258 *yptr = real_y;
e9445337
RS		 1259}
1260
f676886a 1261/* Insert a description of internally-recorded parameters of frame X
01f1ba30
JB		 1262 into the parameter alist *ALISTPTR that is to be given to the user.
1263 Only parameters that are specific to the X window system
f676886a 1264 and whose values are not correctly recorded in the frame's
01f1ba30
JB		 1265 param_alist need to be considered here. */
1266
968b1234 1267void
f676886a
JB		 1268x_report_frame_params (f, alistptr)
1269 struct frame *f;
01f1ba30
JB		 1270 Lisp_Object *alistptr;
1271{
1272 char buf[16];
9b002b8d
KH		 1273 Lisp_Object tem;
1274
1275 /* Represent negative positions (off the top or left screen edge)
1276 in a way that Fmodify_frame_parameters will understand correctly. */
7556890b
RS		 1277 XSETINT (tem, f->output_data.x->left_pos);
1278 if (f->output_data.x->left_pos >= 0)
9b002b8d
KH		 1279 store_in_alist (alistptr, Qleft, tem);
1280 else
1281 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1282
7556890b
RS		 1283 XSETINT (tem, f->output_data.x->top_pos);
1284 if (f->output_data.x->top_pos >= 0)
9b002b8d
KH		 1285 store_in_alist (alistptr, Qtop, tem);
1286 else
1287 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
01f1ba30 1288
f9942c9e 1289 store_in_alist (alistptr, Qborder_width,
7556890b 1290 make_number (f->output_data.x->border_width));
f9942c9e 1291 store_in_alist (alistptr, Qinternal_border_width,
7556890b 1292 make_number (f->output_data.x->internal_border_width));
30bf44e0
KS		 1293 store_in_alist (alistptr, Qleft_fringe,
1294 make_number (f->output_data.x->left_fringe_width));
1295 store_in_alist (alistptr, Qright_fringe,
1296 make_number (f->output_data.x->right_fringe_width));
99f7c77f
EZ		 1297 store_in_alist (alistptr, Qscroll_bar_width,
1298 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1299 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f)
1300 : 0));
7c118b57 1301 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
f9942c9e 1302 store_in_alist (alistptr, Qwindow_id,
01f1ba30 1303 build_string (buf));
333b20bb
GM		 1304#ifdef USE_X_TOOLKIT
1305 /* Tooltip frame may not have this widget. */
1306 if (f->output_data.x->widget)
1307#endif
1308 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
2cbebefb
RS		 1309 store_in_alist (alistptr, Qouter_window_id,
1310 build_string (buf));
f468da95 1311 store_in_alist (alistptr, Qicon_name, f->icon_name);
a8ccd803 1312 FRAME_SAMPLE_VISIBILITY (f);
d043f1a4
RS		 1313 store_in_alist (alistptr, Qvisibility,
1314 (FRAME_VISIBLE_P (f) ? Qt
1315 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
34ae77b5 1316 store_in_alist (alistptr, Qdisplay,
8e713be6 1317 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
e4f79258 1318
8c239ac3
RS		 1319 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1320 tem = Qnil;
1321 else
1322 XSETFASTINT (tem, f->output_data.x->parent_desc);
1323 store_in_alist (alistptr, Qparent_id, tem);
01f1ba30
JB		 1324}
1325\f
82978295 1326
d62c8769
GM		 1327
1328/* Gamma-correct COLOR on frame F. */
1329
1330void
1331gamma_correct (f, color)
1332 struct frame *f;
1333 XColor *color;
1334{
1335 if (f->gamma)
1336 {
1337 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1338 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1339 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1340 }
1341}
1342
1343
7b746c38
GM		 1344/* Decide if color named COLOR_NAME is valid for use on frame F. If
1345 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1346 allocate the color. Value is zero if COLOR_NAME is invalid, or
1347 no color could be allocated. */
e12d55b2 1348
01f1ba30 1349int
7b746c38
GM		 1350x_defined_color (f, color_name, color, alloc_p)
1351 struct frame *f;
1352 char *color_name;
1353 XColor *color;
1354 int alloc_p;
01f1ba30 1355{
7b746c38
GM		 1356 int success_p;
1357 Display *dpy = FRAME_X_DISPLAY (f);
1358 Colormap cmap = FRAME_X_COLORMAP (f);
01f1ba30
JB		 1359
1360 BLOCK_INPUT;
7b746c38
GM		 1361 success_p = XParseColor (dpy, cmap, color_name, color);
1362 if (success_p && alloc_p)
1363 success_p = x_alloc_nearest_color (f, cmap, color);
01f1ba30
JB		 1364 UNBLOCK_INPUT;
1365
7b746c38 1366 return success_p;
01f1ba30
JB		 1367}
1368
9b2956e2
GM		 1369
1370/* Return the pixel color value for color COLOR_NAME on frame F. If F
1371 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1372 Signal an error if color can't be allocated. */
01f1ba30
JB		 1373
1374int
9b2956e2 1375x_decode_color (f, color_name, mono_color)
b9dc4443 1376 FRAME_PTR f;
9b2956e2
GM		 1377 Lisp_Object color_name;
1378 int mono_color;
01f1ba30 1379{
b9dc4443 1380 XColor cdef;
01f1ba30 1381
b7826503 1382 CHECK_STRING (color_name);
01f1ba30 1383
9b2956e2
GM		 1384#if 0 /* Don't do this. It's wrong when we're not using the default
1385 colormap, it makes freeing difficult, and it's probably not
1386 an important optimization. */
1387 if (strcmp (XSTRING (color_name)->data, "black") == 0)
b9dc4443 1388 return BLACK_PIX_DEFAULT (f);
9b2956e2 1389 else if (strcmp (XSTRING (color_name)->data, "white") == 0)
b9dc4443 1390 return WHITE_PIX_DEFAULT (f);
9b2956e2 1391#endif
01f1ba30 1392
9b2956e2 1393 /* Return MONO_COLOR for monochrome frames. */
b9dc4443 1394 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
9b2956e2 1395 return mono_color;
01f1ba30 1396
2d764c78 1397 /* x_defined_color is responsible for coping with failures
95626e11 1398 by looking for a near-miss. */
9b2956e2 1399 if (x_defined_color (f, XSTRING (color_name)->data, &cdef, 1))
95626e11
RS		 1400 return cdef.pixel;
1401
c301be26
GM		 1402 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1403 Fcons (color_name, Qnil)));
1404 return 0;
01f1ba30 1405}
9b2956e2
GM		 1406
1407
01f1ba30 1408\f
563b67aa
GM		 1409/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1410 the previous value of that parameter, NEW_VALUE is the new value. */
1411
1412static void
1413x_set_line_spacing (f, new_value, old_value)
1414 struct frame *f;
1415 Lisp_Object new_value, old_value;
1416{
1417 if (NILP (new_value))
1418 f->extra_line_spacing = 0;
1419 else if (NATNUMP (new_value))
1420 f->extra_line_spacing = XFASTINT (new_value);
1421 else
1a948b17 1422 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
563b67aa
GM		 1423 Fcons (new_value, Qnil)));
1424 if (FRAME_VISIBLE_P (f))
1425 redraw_frame (f);
1426}
1427
1428
ea0a1f53
GM		 1429/* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1430 the previous value of that parameter, NEW_VALUE is the new value.
1431 See also the comment of wait_for_wm in struct x_output. */
1432
1433static void
1434x_set_wait_for_wm (f, new_value, old_value)
1435 struct frame *f;
1436 Lisp_Object new_value, old_value;
1437{
1438 f->output_data.x->wait_for_wm = !NILP (new_value);
1439}
1440
1441
49d41073
EZ		 1442/* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
1443 the previous value of that parameter, NEW_VALUE is the new value. */
1444
1445static void
1446x_set_fullscreen (f, new_value, old_value)
1447 struct frame *f;
1448 Lisp_Object new_value, old_value;
1449{
1450 if (NILP (new_value))
1451 f->output_data.x->want_fullscreen = FULLSCREEN_NONE;
1452 else if (EQ (new_value, Qfullboth))
1453 f->output_data.x->want_fullscreen = FULLSCREEN_BOTH;
1454 else if (EQ (new_value, Qfullwidth))
1455 f->output_data.x->want_fullscreen = FULLSCREEN_WIDTH;
1456 else if (EQ (new_value, Qfullheight))
1457 f->output_data.x->want_fullscreen = FULLSCREEN_HEIGHT;
1458}
1459
1460
d62c8769 1461/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
ea0a1f53
GM		 1462 the previous value of that parameter, NEW_VALUE is the new
1463 value. */
d62c8769
GM		 1464
1465static void
1466x_set_screen_gamma (f, new_value, old_value)
1467 struct frame *f;
1468 Lisp_Object new_value, old_value;
1469{
1470 if (NILP (new_value))
1471 f->gamma = 0;
1472 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1473 /* The value 0.4545 is the normal viewing gamma. */
1474 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1475 else
1a948b17 1476 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
d62c8769
GM		 1477 Fcons (new_value, Qnil)));
1478
1479 clear_face_cache (0);
1480}
1481
1482
f676886a 1483/* Functions called only from `x_set_frame_param'
01f1ba30
JB		 1484 to set individual parameters.
1485
fe24a618 1486 If FRAME_X_WINDOW (f) is 0,
f676886a 1487 the frame is being created and its X-window does not exist yet.
01f1ba30
JB		 1488 In that case, just record the parameter's new value
1489 in the standard place; do not attempt to change the window. */
1490
1491void
f676886a
JB		 1492x_set_foreground_color (f, arg, oldval)
1493 struct frame *f;
01f1ba30
JB		 1494 Lisp_Object arg, oldval;
1495{
09393d07
GM		 1496 struct x_output *x = f->output_data.x;
1497 unsigned long fg, old_fg;
a76206dc 1498
09393d07
GM		 1499 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1500 old_fg = x->foreground_pixel;
1501 x->foreground_pixel = fg;
a76206dc 1502
fe24a618 1503 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1504 {
09393d07 1505 Display *dpy = FRAME_X_DISPLAY (f);
36d42089 1506
09393d07
GM		 1507 BLOCK_INPUT;
1508 XSetForeground (dpy, x->normal_gc, fg);
1509 XSetBackground (dpy, x->reverse_gc, fg);
36d42089 1510
09393d07
GM		 1511 if (x->cursor_pixel == old_fg)
1512 {
1513 unload_color (f, x->cursor_pixel);
1514 x->cursor_pixel = x_copy_color (f, fg);
1515 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1516 }
1517
01f1ba30 1518 UNBLOCK_INPUT;
09393d07 1519
05c8abbe 1520 update_face_from_frame_parameter (f, Qforeground_color, arg);
09393d07 1521
179956b9 1522 if (FRAME_VISIBLE_P (f))
f676886a 1523 redraw_frame (f);
01f1ba30 1524 }
09393d07
GM		 1525
1526 unload_color (f, old_fg);
01f1ba30
JB		 1527}
1528
1529void
f676886a
JB		 1530x_set_background_color (f, arg, oldval)
1531 struct frame *f;
01f1ba30
JB		 1532 Lisp_Object arg, oldval;
1533{
09393d07
GM		 1534 struct x_output *x = f->output_data.x;
1535 unsigned long bg;
01f1ba30 1536
09393d07
GM		 1537 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1538 unload_color (f, x->background_pixel);
1539 x->background_pixel = bg;
a76206dc 1540
fe24a618 1541 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1542 {
09393d07 1543 Display *dpy = FRAME_X_DISPLAY (f);
36d42089 1544
09393d07
GM		 1545 BLOCK_INPUT;
1546 XSetBackground (dpy, x->normal_gc, bg);
1547 XSetForeground (dpy, x->reverse_gc, bg);
1548 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1549 XSetForeground (dpy, x->cursor_gc, bg);
1550
f76e0368
GM		 1551#ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1552 toolkit scroll bars. */
1553 {
1554 Lisp_Object bar;
1555 for (bar = FRAME_SCROLL_BARS (f);
1556 !NILP (bar);
1557 bar = XSCROLL_BAR (bar)->next)
1558 {
1559 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1560 XSetWindowBackground (dpy, window, bg);
1561 }
1562 }
1563#endif /* USE_TOOLKIT_SCROLL_BARS */
01f1ba30 1564
09393d07 1565 UNBLOCK_INPUT;
05c8abbe 1566 update_face_from_frame_parameter (f, Qbackground_color, arg);
ea96210c 1567
179956b9 1568 if (FRAME_VISIBLE_P (f))
f676886a 1569 redraw_frame (f);
01f1ba30
JB		 1570 }
1571}
1572
1573void
f676886a
JB		 1574x_set_mouse_color (f, arg, oldval)
1575 struct frame *f;
01f1ba30
JB		 1576 Lisp_Object arg, oldval;
1577{
09393d07
GM		 1578 struct x_output *x = f->output_data.x;
1579 Display *dpy = FRAME_X_DISPLAY (f);
95f80c78 1580 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
0af913d7 1581 Cursor hourglass_cursor, horizontal_drag_cursor;
1dc6cfa6 1582 int count;
51a1d2d8 1583 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
09393d07 1584 unsigned long mask_color = x->background_pixel;
a76206dc 1585
51a1d2d8 1586 /* Don't let pointers be invisible. */
09393d07 1587 if (mask_color == pixel)
bcf26b38
GM		 1588 {
1589 x_free_colors (f, &pixel, 1);
09393d07 1590 pixel = x_copy_color (f, x->foreground_pixel);
bcf26b38 1591 }
a76206dc 1592
09393d07
GM		 1593 unload_color (f, x->mouse_pixel);
1594 x->mouse_pixel = pixel;
01f1ba30
JB		 1595
1596 BLOCK_INPUT;
fe24a618 1597
eb8c3be9 1598 /* It's not okay to crash if the user selects a screwy cursor. */
09393d07 1599 count = x_catch_errors (dpy);
fe24a618 1600
09393d07 1601 if (!NILP (Vx_pointer_shape))
01f1ba30 1602 {
b7826503 1603 CHECK_NUMBER (Vx_pointer_shape);
09393d07 1604 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
01f1ba30
JB		 1605 }
1606 else
09393d07
GM		 1607 cursor = XCreateFontCursor (dpy, XC_xterm);
1608 x_check_errors (dpy, "bad text pointer cursor: %s");
01f1ba30 1609
09393d07 1610 if (!NILP (Vx_nontext_pointer_shape))
01f1ba30 1611 {
b7826503 1612 CHECK_NUMBER (Vx_nontext_pointer_shape);
09393d07
GM		 1613 nontext_cursor
1614 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
01f1ba30
JB		 1615 }
1616 else
09393d07
GM		 1617 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1618 x_check_errors (dpy, "bad nontext pointer cursor: %s");
01f1ba30 1619
09393d07 1620 if (!NILP (Vx_hourglass_pointer_shape))
333b20bb 1621 {
b7826503 1622 CHECK_NUMBER (Vx_hourglass_pointer_shape);
09393d07
GM		 1623 hourglass_cursor
1624 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
333b20bb
GM		 1625 }
1626 else
09393d07
GM		 1627 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1628 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
333b20bb 1629
09393d07
GM		 1630 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1631 if (!NILP (Vx_mode_pointer_shape))
01f1ba30 1632 {
b7826503 1633 CHECK_NUMBER (Vx_mode_pointer_shape);
09393d07 1634 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
01f1ba30
JB		 1635 }
1636 else
09393d07
GM		 1637 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1638 x_check_errors (dpy, "bad modeline pointer cursor: %s");
95f80c78 1639
09393d07 1640 if (!NILP (Vx_sensitive_text_pointer_shape))
95f80c78 1641 {
b7826503 1642 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
ca0ecbf5 1643 cross_cursor
09393d07 1644 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
95f80c78
FP		 1645 }
1646 else
09393d07 1647 cross_cursor = XCreateFontCursor (dpy, XC_crosshair);
01f1ba30 1648
8fb4ec9c
GM		 1649 if (!NILP (Vx_window_horizontal_drag_shape))
1650 {
b7826503 1651 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
8fb4ec9c 1652 horizontal_drag_cursor
09393d07 1653 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
8fb4ec9c
GM		 1654 }
1655 else
1656 horizontal_drag_cursor
09393d07 1657 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
8fb4ec9c 1658
fe24a618 1659 /* Check and report errors with the above calls. */
09393d07
GM		 1660 x_check_errors (dpy, "can't set cursor shape: %s");
1661 x_uncatch_errors (dpy, count);
fe24a618 1662
01f1ba30
JB		 1663 {
1664 XColor fore_color, back_color;
1665
09393d07 1666 fore_color.pixel = x->mouse_pixel;
a31fedb7 1667 x_query_color (f, &fore_color);
01f1ba30 1668 back_color.pixel = mask_color;
a31fedb7
GM		 1669 x_query_color (f, &back_color);
1670
09393d07
GM		 1671 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1672 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1673 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1674 XRecolorCursor (dpy, cross_cursor, &fore_color, &back_color);
1675 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1676 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
01f1ba30 1677 }
01f1ba30 1678
fe24a618 1679 if (FRAME_X_WINDOW (f) != 0)
09393d07
GM		 1680 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1681
1682 if (cursor != x->text_cursor
1683 && x->text_cursor != 0)
1684 XFreeCursor (dpy, x->text_cursor);
1685 x->text_cursor = cursor;
1686
1687 if (nontext_cursor != x->nontext_cursor
1688 && x->nontext_cursor != 0)
1689 XFreeCursor (dpy, x->nontext_cursor);
1690 x->nontext_cursor = nontext_cursor;
1691
1692 if (hourglass_cursor != x->hourglass_cursor
1693 && x->hourglass_cursor != 0)
1694 XFreeCursor (dpy, x->hourglass_cursor);
1695 x->hourglass_cursor = hourglass_cursor;
1696
1697 if (mode_cursor != x->modeline_cursor
1698 && x->modeline_cursor != 0)
1699 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1700 x->modeline_cursor = mode_cursor;
333b20bb 1701
09393d07
GM		 1702 if (cross_cursor != x->cross_cursor
1703 && x->cross_cursor != 0)
1704 XFreeCursor (dpy, x->cross_cursor);
1705 x->cross_cursor = cross_cursor;
01f1ba30 1706
09393d07
GM		 1707 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1708 && x->horizontal_drag_cursor != 0)
1709 XFreeCursor (dpy, x->horizontal_drag_cursor);
1710 x->horizontal_drag_cursor = horizontal_drag_cursor;
8fb4ec9c 1711
09393d07 1712 XFlush (dpy);
01f1ba30 1713 UNBLOCK_INPUT;
05c8abbe
GM		 1714
1715 update_face_from_frame_parameter (f, Qmouse_color, arg);
01f1ba30
JB		 1716}
1717
1718void
f676886a
JB		 1719x_set_cursor_color (f, arg, oldval)
1720 struct frame *f;
01f1ba30
JB		 1721 Lisp_Object arg, oldval;
1722{
a76206dc 1723 unsigned long fore_pixel, pixel;
10168ebb 1724 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
09393d07 1725 struct x_output *x = f->output_data.x;
01f1ba30 1726
10168ebb
GM		 1727 if (!NILP (Vx_cursor_fore_pixel))
1728 {
1729 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1730 WHITE_PIX_DEFAULT (f));
1731 fore_pixel_allocated_p = 1;
1732 }
01f1ba30 1733 else
09393d07 1734 fore_pixel = x->background_pixel;
10168ebb 1735
a76206dc 1736 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
10168ebb 1737 pixel_allocated_p = 1;
a76206dc 1738
f9942c9e 1739 /* Make sure that the cursor color differs from the background color. */
09393d07 1740 if (pixel == x->background_pixel)
01f1ba30 1741 {
10168ebb
GM		 1742 if (pixel_allocated_p)
1743 {
1744 x_free_colors (f, &pixel, 1);
1745 pixel_allocated_p = 0;
1746 }
1747
09393d07 1748 pixel = x->mouse_pixel;
a76206dc 1749 if (pixel == fore_pixel)
10168ebb
GM		 1750 {
1751 if (fore_pixel_allocated_p)
1752 {
1753 x_free_colors (f, &fore_pixel, 1);
1754 fore_pixel_allocated_p = 0;
1755 }
09393d07 1756 fore_pixel = x->background_pixel;
10168ebb 1757 }
01f1ba30 1758 }
a76206dc 1759
09393d07 1760 unload_color (f, x->cursor_foreground_pixel);
10168ebb
GM		 1761 if (!fore_pixel_allocated_p)
1762 fore_pixel = x_copy_color (f, fore_pixel);
09393d07 1763 x->cursor_foreground_pixel = fore_pixel;
01f1ba30 1764
09393d07 1765 unload_color (f, x->cursor_pixel);
10168ebb
GM		 1766 if (!pixel_allocated_p)
1767 pixel = x_copy_color (f, pixel);
09393d07 1768 x->cursor_pixel = pixel;
a76206dc 1769
fe24a618 1770 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1771 {
01f1ba30 1772 BLOCK_INPUT;
09393d07
GM		 1773 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1774 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
01f1ba30 1775 UNBLOCK_INPUT;
01f1ba30 1776
179956b9 1777 if (FRAME_VISIBLE_P (f))
01f1ba30 1778 {
cedadcfa
RS		 1779 x_update_cursor (f, 0);
1780 x_update_cursor (f, 1);
01f1ba30
JB		 1781 }
1782 }
05c8abbe
GM		 1783
1784 update_face_from_frame_parameter (f, Qcursor_color, arg);
01f1ba30 1785}
943b580d 1786\f
f676886a 1787/* Set the border-color of frame F to value described by ARG.
01f1ba30
JB		 1788 ARG can be a string naming a color.
1789 The border-color is used for the border that is drawn by the X server.
1790 Note that this does not fully take effect if done before
f676886a 1791 F has an x-window; it must be redone when the window is created.
01f1ba30
JB		 1792
1793 Note: this is done in two routines because of the way X10 works.
1794
1795 Note: under X11, this is normally the province of the window manager,
b9dc4443 1796 and so emacs' border colors may be overridden. */
01f1ba30
JB		 1797
1798void
f676886a
JB		 1799x_set_border_color (f, arg, oldval)
1800 struct frame *f;
01f1ba30
JB		 1801 Lisp_Object arg, oldval;
1802{
01f1ba30
JB		 1803 int pix;
1804
b7826503 1805 CHECK_STRING (arg);
b9dc4443 1806 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
f676886a 1807 x_set_border_pixel (f, pix);
05c8abbe 1808 update_face_from_frame_parameter (f, Qborder_color, arg);
01f1ba30
JB		 1809}
1810
f676886a 1811/* Set the border-color of frame F to pixel value PIX.
01f1ba30 1812 Note that this does not fully take effect if done before
f676886a 1813 F has an x-window. */
01f1ba30 1814
968b1234 1815void
f676886a
JB		 1816x_set_border_pixel (f, pix)
1817 struct frame *f;
01f1ba30
JB		 1818 int pix;
1819{
a76206dc 1820 unload_color (f, f->output_data.x->border_pixel);
7556890b 1821 f->output_data.x->border_pixel = pix;
01f1ba30 1822
7556890b 1823 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
01f1ba30 1824 {
01f1ba30 1825 BLOCK_INPUT;
b9dc4443 1826 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
270958e8 1827 (unsigned long)pix);
01f1ba30
JB		 1828 UNBLOCK_INPUT;
1829
179956b9 1830 if (FRAME_VISIBLE_P (f))
f676886a 1831 redraw_frame (f);
01f1ba30
JB		 1832 }
1833}
1834
0d1469d6
GM		 1835
1836/* Value is the internal representation of the specified cursor type
1837 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1838 of the bar cursor. */
1839
1840enum text_cursor_kinds
1841x_specified_cursor_type (arg, width)
1842 Lisp_Object arg;
1843 int *width;
dbc4e1c1 1844{
0d1469d6
GM		 1845 enum text_cursor_kinds type;
1846
dbc4e1c1 1847 if (EQ (arg, Qbar))
c3211206 1848 {
0d1469d6
GM		 1849 type = BAR_CURSOR;
1850 *width = 2;
c3211206 1851 }
08ac8554
GM		 1852 else if (CONSP (arg)
1853 && EQ (XCAR (arg), Qbar)
1854 && INTEGERP (XCDR (arg))
1855 && XINT (XCDR (arg)) >= 0)
c3211206 1856 {
0d1469d6
GM		 1857 type = BAR_CURSOR;
1858 *width = XINT (XCDR (arg));
c3211206 1859 }
08ac8554 1860 else if (NILP (arg))
0d1469d6 1861 type = NO_CURSOR;
dbc4e1c1 1862 else
c3211206
RS		 1863 /* Treat anything unknown as "box cursor".
1864 It was bad to signal an error; people have trouble fixing
1865 .Xdefaults with Emacs, when it has something bad in it. */
0d1469d6
GM		 1866 type = FILLED_BOX_CURSOR;
1867
1868 return type;
1869}
1870
1871void
1872x_set_cursor_type (f, arg, oldval)
1873 FRAME_PTR f;
1874 Lisp_Object arg, oldval;
1875{
1876 int width;
1877
1878 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
1879 f->output_data.x->cursor_width = width;
dbc4e1c1
JB		 1880
1881 /* Make sure the cursor gets redrawn. This is overkill, but how
1882 often do people change cursor types? */
1883 update_mode_lines++;
1884}
943b580d 1885\f
01f1ba30 1886void
f676886a
JB		 1887x_set_icon_type (f, arg, oldval)
1888 struct frame *f;
01f1ba30
JB		 1889 Lisp_Object arg, oldval;
1890{
01f1ba30
JB		 1891 int result;
1892
203c1d73
RS		 1893 if (STRINGP (arg))
1894 {
1895 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1896 return;
1897 }
1898 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
01f1ba30
JB		 1899 return;
1900
1901 BLOCK_INPUT;
265a9e55 1902 if (NILP (arg))
80534dd6 1903 result = x_text_icon (f,
f468da95
RS		 1904 (char *) XSTRING ((!NILP (f->icon_name)
1905 ? f->icon_name
80534dd6 1906 : f->name))->data);
f1c7b5a6
RS		 1907 else
1908 result = x_bitmap_icon (f, arg);
01f1ba30
JB		 1909
1910 if (result)
1911 {
01f1ba30 1912 UNBLOCK_INPUT;
0fb53770 1913 error ("No icon window available");
01f1ba30
JB		 1914 }
1915
b9dc4443 1916 XFlush (FRAME_X_DISPLAY (f));
01f1ba30
JB		 1917 UNBLOCK_INPUT;
1918}
1919
f1c7b5a6 1920/* Return non-nil if frame F wants a bitmap icon. */
0fb53770 1921
f1c7b5a6 1922Lisp_Object
0fb53770
RS		 1923x_icon_type (f)
1924 FRAME_PTR f;
1925{
1926 Lisp_Object tem;
1927
1928 tem = assq_no_quit (Qicon_type, f->param_alist);
f1c7b5a6 1929 if (CONSP (tem))
8e713be6 1930 return XCDR (tem);
f1c7b5a6
RS		 1931 else
1932 return Qnil;
0fb53770
RS		 1933}
1934
80534dd6
KH		 1935void
1936x_set_icon_name (f, arg, oldval)
1937 struct frame *f;
1938 Lisp_Object arg, oldval;
1939{
80534dd6
KH		 1940 int result;
1941
1942 if (STRINGP (arg))
1943 {
1944 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1945 return;
1946 }
1947 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1948 return;
1949
f468da95 1950 f->icon_name = arg;
80534dd6 1951
7556890b 1952 if (f->output_data.x->icon_bitmap != 0)
80534dd6
KH		 1953 return;
1954
1955 BLOCK_INPUT;
1956
1957 result = x_text_icon (f,
f468da95
RS		 1958 (char *) XSTRING ((!NILP (f->icon_name)
1959 ? f->icon_name
943b580d
RS		 1960 : !NILP (f->title)
1961 ? f->title
80534dd6
KH		 1962 : f->name))->data);
1963
1964 if (result)
1965 {
1966 UNBLOCK_INPUT;
1967 error ("No icon window available");
1968 }
1969
80534dd6
KH		 1970 XFlush (FRAME_X_DISPLAY (f));
1971 UNBLOCK_INPUT;
1972}
943b580d 1973\f
01f1ba30 1974void
f676886a
JB		 1975x_set_font (f, arg, oldval)
1976 struct frame *f;
01f1ba30
JB		 1977 Lisp_Object arg, oldval;
1978{
ea96210c 1979 Lisp_Object result;
942ea06d 1980 Lisp_Object fontset_name;
a367641f 1981 Lisp_Object frame;
57c5889c 1982 int old_fontset = f->output_data.x->fontset;
01f1ba30 1983
b7826503 1984 CHECK_STRING (arg);
01f1ba30 1985
49965a29 1986 fontset_name = Fquery_fontset (arg, Qnil);
942ea06d 1987
01f1ba30 1988 BLOCK_INPUT;
942ea06d
KH		 1989 result = (STRINGP (fontset_name)
1990 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1991 : x_new_font (f, XSTRING (arg)->data));
01f1ba30
JB		 1992 UNBLOCK_INPUT;
1993
ea96210c 1994 if (EQ (result, Qnil))
1c59f5df 1995 error ("Font `%s' is not defined", XSTRING (arg)->data);
ea96210c 1996 else if (EQ (result, Qt))
26e18ed9 1997 error ("The characters of the given font have varying widths");
ea96210c
JB		 1998 else if (STRINGP (result))
1999 {
57c5889c
GM		 2000 if (STRINGP (fontset_name))
2001 {
2002 /* Fontset names are built from ASCII font names, so the
2003 names may be equal despite there was a change. */
2004 if (old_fontset == f->output_data.x->fontset)
2005 return;
2006 }
2007 else if (!NILP (Fequal (result, oldval)))
1d090605 2008 return;
57c5889c 2009
ea96210c 2010 store_frame_param (f, Qfont, result);
333b20bb 2011 recompute_basic_faces (f);
ea96210c
JB		 2012 }
2013 else
2014 abort ();
a367641f 2015
8938a4fb 2016 do_pending_window_change (0);
95aa0336 2017
333b20bb
GM		 2018 /* Don't call `face-set-after-frame-default' when faces haven't been
2019 initialized yet. This is the case when called from
2020 Fx_create_frame. In that case, the X widget or window doesn't
2021 exist either, and we can end up in x_report_frame_params with a
2022 null widget which gives a segfault. */
2023 if (FRAME_FACE_CACHE (f))
2024 {
2025 XSETFRAME (frame, f);
2026 call1 (Qface_set_after_frame_default, frame);
2027 }
01f1ba30
JB		 2028}
2029
b3ba0aa8
KS		 2030static void
2031x_set_fringe_width (f, new_value, old_value)
2032 struct frame *f;
2033 Lisp_Object new_value, old_value;
2034{
2035 x_compute_fringe_widths (f, 1);
2036}
2037
01f1ba30 2038void
f676886a
JB		 2039x_set_border_width (f, arg, oldval)
2040 struct frame *f;
01f1ba30
JB		 2041 Lisp_Object arg, oldval;
2042{
b7826503 2043 CHECK_NUMBER (arg);
01f1ba30 2044
7556890b 2045 if (XINT (arg) == f->output_data.x->border_width)
01f1ba30
JB		 2046 return;
2047
fe24a618 2048 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB		 2049 error ("Cannot change the border width of a window");
2050
7556890b 2051 f->output_data.x->border_width = XINT (arg);
01f1ba30
JB		 2052}
2053
2054void
f676886a
JB		 2055x_set_internal_border_width (f, arg, oldval)
2056 struct frame *f;
01f1ba30
JB		 2057 Lisp_Object arg, oldval;
2058{
7556890b 2059 int old = f->output_data.x->internal_border_width;
01f1ba30 2060
b7826503 2061 CHECK_NUMBER (arg);
7556890b
RS		 2062 f->output_data.x->internal_border_width = XINT (arg);
2063 if (f->output_data.x->internal_border_width < 0)
2064 f->output_data.x->internal_border_width = 0;
01f1ba30 2065
d3b06468 2066#ifdef USE_X_TOOLKIT
2a8a07d4 2067 if (f->output_data.x->edit_widget)
968b1234 2068 widget_store_internal_border (f->output_data.x->edit_widget);
d3b06468 2069#endif
2a8a07d4 2070
7556890b 2071 if (f->output_data.x->internal_border_width == old)
01f1ba30
JB		 2072 return;
2073
fe24a618 2074 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 2075 {
363f7e15 2076 x_set_window_size (f, 0, f->width, f->height);
f676886a 2077 SET_FRAME_GARBAGED (f);
8938a4fb 2078 do_pending_window_change (0);
01f1ba30 2079 }
ea42193a
GM		 2080 else
2081 SET_FRAME_GARBAGED (f);
01f1ba30
JB		 2082}
2083
d043f1a4
RS		 2084void
2085x_set_visibility (f, value, oldval)
2086 struct frame *f;
2087 Lisp_Object value, oldval;
2088{
2089 Lisp_Object frame;
191ed777 2090 XSETFRAME (frame, f);
d043f1a4
RS		 2091
2092 if (NILP (value))
363f7e15 2093 Fmake_frame_invisible (frame, Qt);
49795535 2094 else if (EQ (value, Qicon))
d043f1a4 2095 Ficonify_frame (frame);
49795535
JB		 2096 else
2097 Fmake_frame_visible (frame);
d043f1a4 2098}
52de7ce9 2099
943b580d 2100\f
52de7ce9
GM		 2101/* Change window heights in windows rooted in WINDOW by N lines. */
2102
d043f1a4 2103static void
52de7ce9 2104x_change_window_heights (window, n)
d043f1a4
RS		 2105 Lisp_Object window;
2106 int n;
2107{
47c0f58b 2108 struct window *w = XWINDOW (window);
d043f1a4 2109
e33f7330
KH		 2110 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2111 XSETFASTINT (w->height, XFASTINT (w->height) - n);
d043f1a4 2112
4336c705
GM		 2113 if (INTEGERP (w->orig_top))
2114 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2115 if (INTEGERP (w->orig_height))
2116 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2117
47c0f58b
RS		 2118 /* Handle just the top child in a vertical split. */
2119 if (!NILP (w->vchild))
52de7ce9 2120 x_change_window_heights (w->vchild, n);
d043f1a4 2121
47c0f58b
RS		 2122 /* Adjust all children in a horizontal split. */
2123 for (window = w->hchild; !NILP (window); window = w->next)
2124 {
2125 w = XWINDOW (window);
52de7ce9 2126 x_change_window_heights (window, n);
d043f1a4
RS		 2127 }
2128}
2129
2130void
2131x_set_menu_bar_lines (f, value, oldval)
2132 struct frame *f;
2133 Lisp_Object value, oldval;
2134{
2135 int nlines;
b6d7acec 2136#ifndef USE_X_TOOLKIT
d043f1a4 2137 int olines = FRAME_MENU_BAR_LINES (f);
b6d7acec 2138#endif
d043f1a4 2139
f64ba6ea
JB		 2140 /* Right now, menu bars don't work properly in minibuf-only frames;
2141 most of the commands try to apply themselves to the minibuffer
333b20bb 2142 frame itself, and get an error because you can't switch buffers
f64ba6ea 2143 in or split the minibuffer window. */
519066d2 2144 if (FRAME_MINIBUF_ONLY_P (f))
f64ba6ea
JB		 2145 return;
2146
6a5e54e2 2147 if (INTEGERP (value))
d043f1a4
RS		 2148 nlines = XINT (value);
2149 else
2150 nlines = 0;
2151
3d09b6be
RS		 2152 /* Make sure we redisplay all windows in this frame. */
2153 windows_or_buffers_changed++;
2154
9ef48a9d
RS		 2155#ifdef USE_X_TOOLKIT
2156 FRAME_MENU_BAR_LINES (f) = 0;
2157 if (nlines)
0d8ef3f4
RS		 2158 {
2159 FRAME_EXTERNAL_MENU_BAR (f) = 1;
97a1ff91 2160 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
0d8ef3f4
RS		 2161 /* Make sure next redisplay shows the menu bar. */
2162 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
2163 }
9ef48a9d
RS		 2164 else
2165 {
6bc20398
FP		 2166 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2167 free_frame_menubar (f);
9ef48a9d 2168 FRAME_EXTERNAL_MENU_BAR (f) = 0;
97a1ff91
RS		 2169 if (FRAME_X_P (f))
2170 f->output_data.x->menubar_widget = 0;
9ef48a9d
RS		 2171 }
2172#else /* not USE_X_TOOLKIT */
d043f1a4 2173 FRAME_MENU_BAR_LINES (f) = nlines;
52de7ce9 2174 x_change_window_heights (f->root_window, nlines - olines);
9ef48a9d 2175#endif /* not USE_X_TOOLKIT */
333b20bb
GM		 2176 adjust_glyphs (f);
2177}
2178
2179
2180/* Set the number of lines used for the tool bar of frame F to VALUE.
2181 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2182 is the old number of tool bar lines. This function changes the
2183 height of all windows on frame F to match the new tool bar height.
2184 The frame's height doesn't change. */
2185
2186void
9ea173e8 2187x_set_tool_bar_lines (f, value, oldval)
333b20bb
GM		 2188 struct frame *f;
2189 Lisp_Object value, oldval;
2190{
52de7ce9
GM		 2191 int delta, nlines, root_height;
2192 Lisp_Object root_window;
333b20bb 2193
e870b7ba
GM		 2194 /* Treat tool bars like menu bars. */
2195 if (FRAME_MINIBUF_ONLY_P (f))
2196 return;
2197
333b20bb
GM		 2198 /* Use VALUE only if an integer >= 0. */
2199 if (INTEGERP (value) && XINT (value) >= 0)
2200 nlines = XFASTINT (value);
2201 else
2202 nlines = 0;
2203
2204 /* Make sure we redisplay all windows in this frame. */
2205 ++windows_or_buffers_changed;
2206
9ea173e8 2207 delta = nlines - FRAME_TOOL_BAR_LINES (f);
52de7ce9
GM		 2208
2209 /* Don't resize the tool-bar to more than we have room for. */
2210 root_window = FRAME_ROOT_WINDOW (f);
2211 root_height = XINT (XWINDOW (root_window)->height);
2212 if (root_height - delta < 1)
2213 {
2214 delta = root_height - 1;
2215 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2216 }
2217
9ea173e8 2218 FRAME_TOOL_BAR_LINES (f) = nlines;
52de7ce9 2219 x_change_window_heights (root_window, delta);
333b20bb 2220 adjust_glyphs (f);
ccba751c
GM		 2221
2222 /* We also have to make sure that the internal border at the top of
2223 the frame, below the menu bar or tool bar, is redrawn when the
2224 tool bar disappears. This is so because the internal border is
2225 below the tool bar if one is displayed, but is below the menu bar
2226 if there isn't a tool bar. The tool bar draws into the area
2227 below the menu bar. */
2228 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2229 {
2230 updating_frame = f;
2231 clear_frame ();
fb3cd89b 2232 clear_current_matrices (f);
ccba751c
GM		 2233 updating_frame = NULL;
2234 }
b6f91066
GM		 2235
2236 /* If the tool bar gets smaller, the internal border below it
2237 has to be cleared. It was formerly part of the display
2238 of the larger tool bar, and updating windows won't clear it. */
2239 if (delta < 0)
2240 {
2241 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2242 int width = PIXEL_WIDTH (f);
2243 int y = nlines * CANON_Y_UNIT (f);
2244
2245 BLOCK_INPUT;
161d30fd
GM		 2246 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2247 0, y, width, height, False);
b6f91066 2248 UNBLOCK_INPUT;
ddc24747
GM		 2249
2250 if (WINDOWP (f->tool_bar_window))
2251 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
b6f91066 2252 }
333b20bb
GM		 2253}
2254
2255
2256/* Set the foreground color for scroll bars on frame F to VALUE.
2257 VALUE should be a string, a color name. If it isn't a string or
2258 isn't a valid color name, do nothing. OLDVAL is the old value of
2259 the frame parameter. */
2260
2261void
2262x_set_scroll_bar_foreground (f, value, oldval)
2263 struct frame *f;
2264 Lisp_Object value, oldval;
2265{
2266 unsigned long pixel;
2267
2268 if (STRINGP (value))
2269 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
2270 else
2271 pixel = -1;
2272
2273 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
2274 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
2275
2276 f->output_data.x->scroll_bar_foreground_pixel = pixel;
2277 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2278 {
2279 /* Remove all scroll bars because they have wrong colors. */
2280 if (condemn_scroll_bars_hook)
2281 (*condemn_scroll_bars_hook) (f);
2282 if (judge_scroll_bars_hook)
2283 (*judge_scroll_bars_hook) (f);
05c8abbe
GM		 2284
2285 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
333b20bb
GM		 2286 redraw_frame (f);
2287 }
2288}
2289
2290
2291/* Set the background color for scroll bars on frame F to VALUE VALUE
2292 should be a string, a color name. If it isn't a string or isn't a
2293 valid color name, do nothing. OLDVAL is the old value of the frame
2294 parameter. */
2295
2296void
2297x_set_scroll_bar_background (f, value, oldval)
2298 struct frame *f;
2299 Lisp_Object value, oldval;
2300{
2301 unsigned long pixel;
2302
2303 if (STRINGP (value))
2304 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
2305 else
2306 pixel = -1;
2307
2308 if (f->output_data.x->scroll_bar_background_pixel != -1)
2309 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
2310
f15340b7
MB		 2311#ifdef USE_TOOLKIT_SCROLL_BARS
2312 /* Scrollbar shadow colors. */
2313 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
2314 {
2315 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
2316 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
2317 }
2318 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
2319 {
2320 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
2321 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
2322 }
2323#endif /* USE_TOOLKIT_SCROLL_BARS */
2324
333b20bb
GM		 2325 f->output_data.x->scroll_bar_background_pixel = pixel;
2326 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2327 {
2328 /* Remove all scroll bars because they have wrong colors. */
2329 if (condemn_scroll_bars_hook)
2330 (*condemn_scroll_bars_hook) (f);
2331 if (judge_scroll_bars_hook)
2332 (*judge_scroll_bars_hook) (f);
2333
05c8abbe 2334 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
333b20bb
GM		 2335 redraw_frame (f);
2336 }
d043f1a4 2337}
333b20bb 2338
943b580d 2339\f
3a258507 2340/* Encode Lisp string STRING as a text in a format appropriate for
96db09e4
KH		 2341 XICCC (X Inter Client Communication Conventions).
2342
2343 If STRING contains only ASCII characters, do no conversion and
2344 return the string data of STRING. Otherwise, encode the text by
2345 CODING_SYSTEM, and return a newly allocated memory area which
2346 should be freed by `xfree' by a caller.
2347
2348 Store the byte length of resulting text in *TEXT_BYTES.
2349
d60660d6 2350 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
96db09e4 2351 which means that the `encoding' of the result can be `STRING'.
d60660d6 2352 Otherwise store 0 in *STRINGP, which means that the `encoding' of
96db09e4
KH		 2353 the result should be `COMPOUND_TEXT'. */
2354
2355unsigned char *
d60660d6 2356x_encode_text (string, coding_system, text_bytes, stringp)
96db09e4 2357 Lisp_Object string, coding_system;
d60660d6 2358 int *text_bytes, *stringp;
96db09e4
KH		 2359{
2360 unsigned char *str = XSTRING (string)->data;
2361 int chars = XSTRING (string)->size;
2362 int bytes = STRING_BYTES (XSTRING (string));
2363 int charset_info;
2364 int bufsize;
2365 unsigned char *buf;
2366 struct coding_system coding;
2367
2368 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
2369 if (charset_info == 0)
2370 {
2371 /* No multibyte character in OBJ. We need not encode it. */
2372 *text_bytes = bytes;
d60660d6 2373 *stringp = 1;
96db09e4
KH		 2374 return str;
2375 }
2376
2377 setup_coding_system (coding_system, &coding);
2378 coding.src_multibyte = 1;
2379 coding.dst_multibyte = 0;
2380 coding.mode |= CODING_MODE_LAST_BLOCK;
d60660d6
KH		 2381 if (coding.type == coding_type_iso2022)
2382 coding.flags |= CODING_FLAG_ISO_SAFE;
35bc5887
KH		 2383 /* We suppress producing escape sequences for composition. */
2384 coding.composing = COMPOSITION_DISABLED;
96db09e4
KH		 2385 bufsize = encoding_buffer_size (&coding, bytes);
2386 buf = (unsigned char *) xmalloc (bufsize);
2387 encode_coding (&coding, str, buf, bytes, bufsize);
2388 *text_bytes = coding.produced;
d60660d6 2389 *stringp = (charset_info == 1 || !EQ (coding_system, Qcompound_text));
96db09e4
KH		 2390 return buf;
2391}
2392
2393\f
75f9d625 2394/* Change the name of frame F to NAME. If NAME is nil, set F's name to
f945b920
JB		 2395 x_id_name.
2396
2397 If EXPLICIT is non-zero, that indicates that lisp code is setting the
75f9d625
DM		 2398 name; if NAME is a string, set F's name to NAME and set
2399 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
f945b920
JB		 2400
2401 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2402 suggesting a new name, which lisp code should override; if
2403 F->explicit_name is set, ignore the new name; otherwise, set it. */
2404
2405void
2406x_set_name (f, name, explicit)
2407 struct frame *f;
2408 Lisp_Object name;
2409 int explicit;
2410{
2411 /* Make sure that requests from lisp code override requests from
2412 Emacs redisplay code. */
2413 if (explicit)
2414 {
2415 /* If we're switching from explicit to implicit, we had better
2416 update the mode lines and thereby update the title. */
2417 if (f->explicit_name && NILP (name))
cf177271 2418 update_mode_lines = 1;
f945b920
JB		 2419
2420 f->explicit_name = ! NILP (name);
2421 }
2422 else if (f->explicit_name)
2423 return;
2424
2425 /* If NAME is nil, set the name to the x_id_name. */
2426 if (NILP (name))
f10f0b79
RS		 2427 {
2428 /* Check for no change needed in this very common case
2429 before we do any consing. */
08a90d6a
RS		 2430 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
2431 XSTRING (f->name)->data))
f10f0b79 2432 return;
08a90d6a 2433 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
f10f0b79 2434 }
62265f1c 2435 else
b7826503 2436 CHECK_STRING (name);
01f1ba30 2437
f945b920
JB		 2438 /* Don't change the name if it's already NAME. */
2439 if (! NILP (Fstring_equal (name, f->name)))
daa37602
JB		 2440 return;
2441
943b580d
RS		 2442 f->name = name;
2443
2444 /* For setting the frame title, the title parameter should override
2445 the name parameter. */
2446 if (! NILP (f->title))
2447 name = f->title;
2448
fe24a618 2449 if (FRAME_X_WINDOW (f))
01f1ba30 2450 {
01f1ba30 2451 BLOCK_INPUT;
fe24a618
JB		 2452#ifdef HAVE_X11R4
2453 {
80534dd6 2454 XTextProperty text, icon;
d60660d6 2455 int bytes, stringp;
11270583 2456 Lisp_Object coding_system;
80534dd6 2457
11270583
KH		 2458 coding_system = Vlocale_coding_system;
2459 if (NILP (coding_system))
2460 coding_system = Qcompound_text;
2461 text.value = x_encode_text (name, coding_system, &bytes, &stringp);
d60660d6 2462 text.encoding = (stringp ? XA_STRING
96db09e4 2463 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
fe24a618 2464 text.format = 8;
96db09e4 2465 text.nitems = bytes;
80534dd6 2466
96db09e4
KH		 2467 if (NILP (f->icon_name))
2468 {
2469 icon = text;
2470 }
2471 else
2472 {
11270583 2473 icon.value = x_encode_text (f->icon_name, coding_system,
d60660d6
KH		 2474 &bytes, &stringp);
2475 icon.encoding = (stringp ? XA_STRING
96db09e4
KH		 2476 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2477 icon.format = 8;
2478 icon.nitems = bytes;
2479 }
9ef48a9d 2480#ifdef USE_X_TOOLKIT
b9dc4443 2481 XSetWMName (FRAME_X_DISPLAY (f),
7556890b
RS		 2482 XtWindow (f->output_data.x->widget), &text);
2483 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
80534dd6 2484 &icon);
9ef48a9d 2485#else /* not USE_X_TOOLKIT */
b9dc4443 2486 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
80534dd6 2487 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
9ef48a9d 2488#endif /* not USE_X_TOOLKIT */
96db09e4
KH		 2489 if (!NILP (f->icon_name)
2490 && icon.value != XSTRING (f->icon_name)->data)
2491 xfree (icon.value);
2492 if (text.value != XSTRING (name)->data)
2493 xfree (text.value);
fe24a618 2494 }
9ef48a9d 2495#else /* not HAVE_X11R4 */
b9dc4443 2496 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
fe24a618 2497 XSTRING (name)->data);
b9dc4443 2498 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
fe24a618 2499 XSTRING (name)->data);
9ef48a9d 2500#endif /* not HAVE_X11R4 */
01f1ba30
JB		 2501 UNBLOCK_INPUT;
2502 }
f945b920
JB		 2503}
2504
2505/* This function should be called when the user's lisp code has
2506 specified a name for the frame; the name will override any set by the
2507 redisplay code. */
2508void
2509x_explicitly_set_name (f, arg, oldval)
2510 FRAME_PTR f;
2511 Lisp_Object arg, oldval;
2512{
2513 x_set_name (f, arg, 1);
2514}
2515
2516/* This function should be called by Emacs redisplay code to set the
2517 name; names set this way will never override names set by the user's
2518 lisp code. */
25250031 2519void
f945b920
JB		 2520x_implicitly_set_name (f, arg, oldval)
2521 FRAME_PTR f;
2522 Lisp_Object arg, oldval;
2523{
2524 x_set_name (f, arg, 0);
01f1ba30 2525}
943b580d
RS		 2526\f
2527/* Change the title of frame F to NAME.
2528 If NAME is nil, use the frame name as the title.
01f1ba30 2529
943b580d
RS		 2530 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2531 name; if NAME is a string, set F's name to NAME and set
2532 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2533
2534 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2535 suggesting a new name, which lisp code should override; if
2536 F->explicit_name is set, ignore the new name; otherwise, set it. */
2537
2538void
d62c8769 2539x_set_title (f, name, old_name)
943b580d 2540 struct frame *f;
d62c8769 2541 Lisp_Object name, old_name;
943b580d
RS		 2542{
2543 /* Don't change the title if it's already NAME. */
2544 if (EQ (name, f->title))
2545 return;
2546
2547 update_mode_lines = 1;
2548
2549 f->title = name;
2550
2551 if (NILP (name))
2552 name = f->name;
beb403b3 2553 else
b7826503 2554 CHECK_STRING (name);
943b580d
RS		 2555
2556 if (FRAME_X_WINDOW (f))
2557 {
2558 BLOCK_INPUT;
2559#ifdef HAVE_X11R4
2560 {
2561 XTextProperty text, icon;
d60660d6 2562 int bytes, stringp;
11270583 2563 Lisp_Object coding_system;
943b580d 2564
11270583
KH		 2565 coding_system = Vlocale_coding_system;
2566 if (NILP (coding_system))
2567 coding_system = Qcompound_text;
2568 text.value = x_encode_text (name, coding_system, &bytes, &stringp);
d60660d6 2569 text.encoding = (stringp ? XA_STRING
96db09e4 2570 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
943b580d 2571 text.format = 8;
96db09e4 2572 text.nitems = bytes;
943b580d 2573
96db09e4
KH		 2574 if (NILP (f->icon_name))
2575 {
2576 icon = text;
2577 }
2578 else
2579 {
11270583 2580 icon.value = x_encode_text (f->icon_name, coding_system,
d60660d6
KH		 2581 &bytes, &stringp);
2582 icon.encoding = (stringp ? XA_STRING
96db09e4
KH		 2583 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2584 icon.format = 8;
2585 icon.nitems = bytes;
2586 }
943b580d
RS		 2587#ifdef USE_X_TOOLKIT
2588 XSetWMName (FRAME_X_DISPLAY (f),
2589 XtWindow (f->output_data.x->widget), &text);
2590 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2591 &icon);
2592#else /* not USE_X_TOOLKIT */
2593 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2594 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
2595#endif /* not USE_X_TOOLKIT */
96db09e4
KH		 2596 if (!NILP (f->icon_name)
2597 && icon.value != XSTRING (f->icon_name)->data)
2598 xfree (icon.value);
2599 if (text.value != XSTRING (name)->data)
2600 xfree (text.value);
943b580d
RS		 2601 }
2602#else /* not HAVE_X11R4 */
2603 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2604 XSTRING (name)->data);
2605 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2606 XSTRING (name)->data);
2607#endif /* not HAVE_X11R4 */
2608 UNBLOCK_INPUT;
2609 }
2610}
2611\f
01f1ba30 2612void
f676886a
JB		 2613x_set_autoraise (f, arg, oldval)
2614 struct frame *f;
01f1ba30
JB		 2615 Lisp_Object arg, oldval;
2616{
f676886a 2617 f->auto_raise = !EQ (Qnil, arg);
01f1ba30
JB		 2618}
2619
2620void
f676886a
JB		 2621x_set_autolower (f, arg, oldval)
2622 struct frame *f;
01f1ba30
JB		 2623 Lisp_Object arg, oldval;
2624{
f676886a 2625 f->auto_lower = !EQ (Qnil, arg);
01f1ba30 2626}
179956b9 2627
eac358ef
KH		 2628void
2629x_set_unsplittable (f, arg, oldval)
2630 struct frame *f;
2631 Lisp_Object arg, oldval;
2632{
2633 f->no_split = !NILP (arg);
2634}
2635
179956b9 2636void
a3c87d4e 2637x_set_vertical_scroll_bars (f, arg, oldval)
179956b9
JB		 2638 struct frame *f;
2639 Lisp_Object arg, oldval;
2640{
1ab3d87e
RS		 2641 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2642 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2643 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2644 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
179956b9 2645 {
1ab3d87e
RS		 2646 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2647 = (NILP (arg)
2648 ? vertical_scroll_bar_none
2649 : EQ (Qright, arg)
2650 ? vertical_scroll_bar_right
2651 : vertical_scroll_bar_left);
179956b9 2652
cf177271
JB		 2653 /* We set this parameter before creating the X window for the
2654 frame, so we can get the geometry right from the start.
2655 However, if the window hasn't been created yet, we shouldn't
2656 call x_set_window_size. */
2657 if (FRAME_X_WINDOW (f))
363f7e15 2658 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
8938a4fb 2659 do_pending_window_change (0);
179956b9
JB		 2660 }
2661}
4701395c
KH		 2662
2663void
2664x_set_scroll_bar_width (f, arg, oldval)
2665 struct frame *f;
2666 Lisp_Object arg, oldval;
2667{
a672c74d
RS		 2668 int wid = FONT_WIDTH (f->output_data.x->font);
2669
dff9a538
KH		 2670 if (NILP (arg))
2671 {
c6e9d03b
GM		 2672#ifdef USE_TOOLKIT_SCROLL_BARS
2673 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
333b20bb
GM		 2674 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2675 FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2676 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
2677#else
2678 /* Make the actual width at least 14 pixels and a multiple of a
2679 character width. */
a672c74d 2680 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
333b20bb
GM		 2681
2682 /* Use all of that space (aside from required margins) for the
2683 scroll bar. */
dff9a538 2684 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
333b20bb 2685#endif
a672c74d 2686
a90ab372
RS		 2687 if (FRAME_X_WINDOW (f))
2688 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
8938a4fb 2689 do_pending_window_change (0);
dff9a538
KH		 2690 }
2691 else if (INTEGERP (arg) && XINT (arg) > 0
2692 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
4701395c 2693 {
09d8c7ac
RS		 2694 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2695 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
0a26b136 2696
4701395c
KH		 2697 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2698 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2699 if (FRAME_X_WINDOW (f))
2700 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2701 }
dca97592 2702
8938a4fb 2703 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
333b20bb
GM		 2704 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2705 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
4701395c 2706}
333b20bb
GM		 2707
2708
01f1ba30 2709\f
f676886a 2710/* Subroutines of creating an X frame. */
01f1ba30 2711
b7975ee4
KH		 2712/* Make sure that Vx_resource_name is set to a reasonable value.
2713 Fix it up, or set it to `emacs' if it is too hopeless. */
2714
d387c960
JB		 2715static void
2716validate_x_resource_name ()
2717{
333b20bb 2718 int len = 0;
0e78b377
RS		 2719 /* Number of valid characters in the resource name. */
2720 int good_count = 0;
2721 /* Number of invalid characters in the resource name. */
2722 int bad_count = 0;
2723 Lisp_Object new;
2724 int i;
2725
498e9ac3
RS		 2726 if (!STRINGP (Vx_resource_class))
2727 Vx_resource_class = build_string (EMACS_CLASS);
2728
cf204347
RS		 2729 if (STRINGP (Vx_resource_name))
2730 {
cf204347
RS		 2731 unsigned char *p = XSTRING (Vx_resource_name)->data;
2732 int i;
2733
fc932ac6 2734 len = STRING_BYTES (XSTRING (Vx_resource_name));
0e78b377
RS		 2735
2736 /* Only letters, digits, - and _ are valid in resource names.
2737 Count the valid characters and count the invalid ones. */
cf204347
RS		 2738 for (i = 0; i < len; i++)
2739 {
2740 int c = p[i];
2741 if (! ((c >= 'a' && c <= 'z')
2742 || (c >= 'A' && c <= 'Z')
2743 || (c >= '0' && c <= '9')
2744 || c == '-' || c == '_'))
0e78b377
RS		 2745 bad_count++;
2746 else
2747 good_count++;
cf204347
RS		 2748 }
2749 }
2750 else
0e78b377
RS		 2751 /* Not a string => completely invalid. */
2752 bad_count = 5, good_count = 0;
2753
2754 /* If name is valid already, return. */
2755 if (bad_count == 0)
2756 return;
2757
2758 /* If name is entirely invalid, or nearly so, use `emacs'. */
2759 if (good_count == 0
2760 || (good_count == 1 && bad_count > 0))
2761 {
b7975ee4 2762 Vx_resource_name = build_string ("emacs");
0e78b377
RS		 2763 return;
2764 }
2765
2766 /* Name is partly valid. Copy it and replace the invalid characters
2767 with underscores. */
2768
2769 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2770
2771 for (i = 0; i < len; i++)
2772 {
2773 int c = XSTRING (new)->data[i];
2774 if (! ((c >= 'a' && c <= 'z')
2775 || (c >= 'A' && c <= 'Z')
2776 || (c >= '0' && c <= '9')
2777 || c == '-' || c == '_'))
2778 XSTRING (new)->data[i] = '_';
2779 }
d387c960
JB		 2780}
2781
2782
01f1ba30 2783extern char *x_get_string_resource ();
01f1ba30 2784
cf177271 2785DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
03265352 2786 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
c061c855
GM		 2787This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2788class, where INSTANCE is the name under which Emacs was invoked, or
2789the name specified by the `-name' or `-rn' command-line arguments.
2790
2791The optional arguments COMPONENT and SUBCLASS add to the key and the
2792class, respectively. You must specify both of them or neither.
2793If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
7ee72033
MB		 2794and the class is `Emacs.CLASS.SUBCLASS'. */)
2795 (attribute, class, component, subclass)
cf177271 2796 Lisp_Object attribute, class, component, subclass;
01f1ba30
JB		 2797{
2798 register char *value;
2799 char *name_key;
2800 char *class_key;
2801
11ae94fe
RS		 2802 check_x ();
2803
b7826503
PJ		 2804 CHECK_STRING (attribute);
2805 CHECK_STRING (class);
cf177271 2806
8fabe6f4 2807 if (!NILP (component))
b7826503 2808 CHECK_STRING (component);
8fabe6f4 2809 if (!NILP (subclass))
b7826503 2810 CHECK_STRING (subclass);
8fabe6f4
RS		 2811 if (NILP (component) != NILP (subclass))
2812 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2813
d387c960
JB		 2814 validate_x_resource_name ();
2815
b7975ee4
KH		 2816 /* Allocate space for the components, the dots which separate them,
2817 and the final '\0'. Make them big enough for the worst case. */
fc932ac6 2818 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
b7975ee4 2819 + (STRINGP (component)
fc932ac6
RS		 2820 ? STRING_BYTES (XSTRING (component)) : 0)
2821 + STRING_BYTES (XSTRING (attribute))
b7975ee4
KH		 2822 + 3);
2823
fc932ac6
RS		 2824 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2825 + STRING_BYTES (XSTRING (class))
b7975ee4 2826 + (STRINGP (subclass)
fc932ac6 2827 ? STRING_BYTES (XSTRING (subclass)) : 0)
b7975ee4
KH		 2828 + 3);
2829
2830 /* Start with emacs.FRAMENAME for the name (the specific one)
2831 and with `Emacs' for the class key (the general one). */
2832 strcpy (name_key, XSTRING (Vx_resource_name)->data);
498e9ac3 2833 strcpy (class_key, XSTRING (Vx_resource_class)->data);
b7975ee4
KH		 2834
2835 strcat (class_key, ".");
2836 strcat (class_key, XSTRING (class)->data);
2837
2838 if (!NILP (component))
01f1ba30 2839 {
b7975ee4
KH		 2840 strcat (class_key, ".");
2841 strcat (class_key, XSTRING (subclass)->data);
2842
2843 strcat (name_key, ".");
2844 strcat (name_key, XSTRING (component)->data);
01f1ba30
JB		 2845 }
2846
b7975ee4
KH		 2847 strcat (name_key, ".");
2848 strcat (name_key, XSTRING (attribute)->data);
2849
b9dc4443
RS		 2850 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2851 name_key, class_key);
01f1ba30
JB		 2852
2853 if (value != (char *) 0)
2854 return build_string (value);
2855 else
2856 return Qnil;
2857}
2858
abb4b7ec
RS		 2859/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2860
333b20bb 2861Lisp_Object
abb4b7ec
RS		 2862display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2863 struct x_display_info *dpyinfo;
2864 Lisp_Object attribute, class, component, subclass;
2865{
2866 register char *value;
2867 char *name_key;
2868 char *class_key;
2869
b7826503
PJ		 2870 CHECK_STRING (attribute);
2871 CHECK_STRING (class);
abb4b7ec
RS		 2872
2873 if (!NILP (component))
b7826503 2874 CHECK_STRING (component);
abb4b7ec 2875 if (!NILP (subclass))
b7826503 2876 CHECK_STRING (subclass);
abb4b7ec
RS		 2877 if (NILP (component) != NILP (subclass))
2878 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2879
2880 validate_x_resource_name ();
2881
2882 /* Allocate space for the components, the dots which separate them,
2883 and the final '\0'. Make them big enough for the worst case. */
fc932ac6 2884 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
abb4b7ec 2885 + (STRINGP (component)
fc932ac6
RS		 2886 ? STRING_BYTES (XSTRING (component)) : 0)
2887 + STRING_BYTES (XSTRING (attribute))
abb4b7ec
RS		 2888 + 3);
2889
fc932ac6
RS		 2890 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2891 + STRING_BYTES (XSTRING (class))
abb4b7ec 2892 + (STRINGP (subclass)
fc932ac6 2893 ? STRING_BYTES (XSTRING (subclass)) : 0)
abb4b7ec
RS		 2894 + 3);
2895
2896 /* Start with emacs.FRAMENAME for the name (the specific one)
2897 and with `Emacs' for the class key (the general one). */
2898 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2899 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2900
2901 strcat (class_key, ".");
2902 strcat (class_key, XSTRING (class)->data);
2903
2904 if (!NILP (component))
2905 {
2906 strcat (class_key, ".");
2907 strcat (class_key, XSTRING (subclass)->data);
2908
2909 strcat (name_key, ".");
2910 strcat (name_key, XSTRING (component)->data);
2911 }
2912
2913 strcat (name_key, ".");
2914 strcat (name_key, XSTRING (attribute)->data);
2915
2916 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2917
2918 if (value != (char *) 0)
2919 return build_string (value);
2920 else
2921 return Qnil;
2922}
2923
3402e1a4
RS		 2924/* Used when C code wants a resource value. */
2925
2926char *
2927x_get_resource_string (attribute, class)
2928 char *attribute, *class;
2929{
3402e1a4
RS		 2930 char *name_key;
2931 char *class_key;
0fe92f72 2932 struct frame *sf = SELECTED_FRAME ();
3402e1a4
RS		 2933
2934 /* Allocate space for the components, the dots which separate them,
2935 and the final '\0'. */
fc932ac6 2936 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
3402e1a4
RS		 2937 + strlen (attribute) + 2);
2938 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2939 + strlen (class) + 2);
2940
2941 sprintf (name_key, "%s.%s",
2942 XSTRING (Vinvocation_name)->data,
2943 attribute);
2944 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2945
0fe92f72 2946 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
b9dc4443 2947 name_key, class_key);
3402e1a4
RS		 2948}
2949
60fb3ee1
JB		 2950/* Types we might convert a resource string into. */
2951enum resource_types
333b20bb
GM		 2952{
2953 RES_TYPE_NUMBER,
d62c8769 2954 RES_TYPE_FLOAT,
333b20bb
GM		 2955 RES_TYPE_BOOLEAN,
2956 RES_TYPE_STRING,
2957 RES_TYPE_SYMBOL
2958};
60fb3ee1 2959
01f1ba30 2960/* Return the value of parameter PARAM.
60fb3ee1 2961
f676886a 2962 First search ALIST, then Vdefault_frame_alist, then the X defaults
cf177271 2963 database, using ATTRIBUTE as the attribute name and CLASS as its class.
60fb3ee1
JB		 2964
2965 Convert the resource to the type specified by desired_type.
2966
f9942c9e
JB		 2967 If no default is specified, return Qunbound. If you call
2968 x_get_arg, make sure you deal with Qunbound in a reasonable way,
a59e4f3d 2969 and don't let it get stored in any Lisp-visible variables! */
01f1ba30
JB		 2970
2971static Lisp_Object
abb4b7ec
RS		 2972x_get_arg (dpyinfo, alist, param, attribute, class, type)
2973 struct x_display_info *dpyinfo;
3c254570 2974 Lisp_Object alist, param;
60fb3ee1 2975 char *attribute;
cf177271 2976 char *class;
60fb3ee1 2977 enum resource_types type;
01f1ba30
JB		 2978{
2979 register Lisp_Object tem;
2980
2981 tem = Fassq (param, alist);
2982 if (EQ (tem, Qnil))
f676886a 2983 tem = Fassq (param, Vdefault_frame_alist);
f9942c9e 2984 if (EQ (tem, Qnil))
01f1ba30 2985 {
60fb3ee1 2986
f9942c9e 2987 if (attribute)
60fb3ee1 2988 {
abb4b7ec
RS		 2989 tem = display_x_get_resource (dpyinfo,
2990 build_string (attribute),
2991 build_string (class),
2992 Qnil, Qnil);
f9942c9e
JB		 2993
2994 if (NILP (tem))
2995 return Qunbound;
2996
2997 switch (type)
2998 {
333b20bb 2999 case RES_TYPE_NUMBER:
f9942c9e
JB		 3000 return make_number (atoi (XSTRING (tem)->data));
3001
d62c8769
GM		 3002 case RES_TYPE_FLOAT:
3003 return make_float (atof (XSTRING (tem)->data));
3004
333b20bb 3005 case RES_TYPE_BOOLEAN:
f9942c9e
JB		 3006 tem = Fdowncase (tem);
3007 if (!strcmp (XSTRING (tem)->data, "on")
3008 || !strcmp (XSTRING (tem)->data, "true"))
3009 return Qt;
3010 else
3011 return Qnil;
3012
333b20bb 3013 case RES_TYPE_STRING:
f9942c9e
JB		 3014 return tem;
3015
333b20bb 3016 case RES_TYPE_SYMBOL:
49795535
JB		 3017 /* As a special case, we map the values `true' and `on'
3018 to Qt, and `false' and `off' to Qnil. */
3019 {
98381190
KH		 3020 Lisp_Object lower;
3021 lower = Fdowncase (tem);
26ae6b61
KH		 3022 if (!strcmp (XSTRING (lower)->data, "on")
3023 || !strcmp (XSTRING (lower)->data, "true"))
49795535 3024 return Qt;
26ae6b61
KH		 3025 else if (!strcmp (XSTRING (lower)->data, "off")
3026 || !strcmp (XSTRING (lower)->data, "false"))
49795535
JB		 3027 return Qnil;
3028 else
89032215 3029 return Fintern (tem, Qnil);
49795535 3030 }
f945b920 3031
f9942c9e
JB		 3032 default:
3033 abort ();
3034 }
60fb3ee1 3035 }
f9942c9e
JB		 3036 else
3037 return Qunbound;
01f1ba30
JB		 3038 }
3039 return Fcdr (tem);
3040}
3041
e4f79258
RS		 3042/* Like x_get_arg, but also record the value in f->param_alist. */
3043
3044static Lisp_Object
3045x_get_and_record_arg (f, alist, param, attribute, class, type)
3046 struct frame *f;
3047 Lisp_Object alist, param;
3048 char *attribute;
3049 char *class;
3050 enum resource_types type;
3051{
3052 Lisp_Object value;
3053
abb4b7ec
RS		 3054 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3055 attribute, class, type);
e4f79258
RS		 3056 if (! NILP (value))
3057 store_frame_param (f, param, value);
3058
3059 return value;
3060}
3061
f676886a 3062/* Record in frame F the specified or default value according to ALIST
e8cc313b
KH		 3063 of the parameter named PROP (a Lisp symbol).
3064 If no value is specified for PROP, look for an X default for XPROP
f676886a 3065 on the frame named NAME.
01f1ba30
JB		 3066 If that is not found either, use the value DEFLT. */
3067
3068static Lisp_Object
cf177271 3069x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
f676886a 3070 struct frame *f;
01f1ba30 3071 Lisp_Object alist;
f9942c9e 3072 Lisp_Object prop;
01f1ba30
JB		 3073 Lisp_Object deflt;
3074 char *xprop;
cf177271 3075 char *xclass;
60fb3ee1 3076 enum resource_types type;
01f1ba30 3077{
01f1ba30
JB		 3078 Lisp_Object tem;
3079
abb4b7ec 3080 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
f9942c9e 3081 if (EQ (tem, Qunbound))
01f1ba30 3082 tem = deflt;
f9942c9e 3083 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
01f1ba30
JB		 3084 return tem;
3085}
333b20bb
GM		 3086
3087
3088/* Record in frame F the specified or default value according to ALIST
3089 of the parameter named PROP (a Lisp symbol). If no value is
3090 specified for PROP, look for an X default for XPROP on the frame
3091 named NAME. If that is not found either, use the value DEFLT. */
3092
3093static Lisp_Object
3094x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
3095 foreground_p)
3096 struct frame *f;
3097 Lisp_Object alist;
3098 Lisp_Object prop;
3099 char *xprop;
3100 char *xclass;
3101 int foreground_p;
3102{
3103 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3104 Lisp_Object tem;
3105
3106 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
3107 if (EQ (tem, Qunbound))
3108 {
3109#ifdef USE_TOOLKIT_SCROLL_BARS
3110
3111 /* See if an X resource for the scroll bar color has been
3112 specified. */
3113 tem = display_x_get_resource (dpyinfo,
3114 build_string (foreground_p
3115 ? "foreground"
3116 : "background"),
c0ec53ad 3117 empty_string,
333b20bb 3118 build_string ("verticalScrollBar"),
c0ec53ad 3119 empty_string);
333b20bb
GM		 3120 if (!STRINGP (tem))
3121 {
3122 /* If nothing has been specified, scroll bars will use a
3123 toolkit-dependent default. Because these defaults are
3124 difficult to get at without actually creating a scroll
3125 bar, use nil to indicate that no color has been
3126 specified. */
3127 tem = Qnil;
3128 }
3129
3130#else /* not USE_TOOLKIT_SCROLL_BARS */
3131
3132 tem = Qnil;
3133
3134#endif /* not USE_TOOLKIT_SCROLL_BARS */
3135 }
3136
3137 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3138 return tem;
3139}
3140
3141
01f1ba30 3142\f
8af1d7ca 3143DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
7ee72033 3144 doc: /* Parse an X-style geometry string STRING.
c061c855
GM		 3145Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3146The properties returned may include `top', `left', `height', and `width'.
3147The value of `left' or `top' may be an integer,
3148or a list (+ N) meaning N pixels relative to top/left corner,
7ee72033
MB		 3149or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3150 (string)
a6605e5c 3151 Lisp_Object string;
01f1ba30
JB		 3152{
3153 int geometry, x, y;
3154 unsigned int width, height;
f83f10ba 3155 Lisp_Object result;
01f1ba30 3156
b7826503 3157 CHECK_STRING (string);
01f1ba30
JB		 3158
3159 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3160 &x, &y, &width, &height);
3161
f83f10ba
RS		 3162#if 0
3163 if (!!(geometry & XValue) != !!(geometry & YValue))
3164 error ("Must specify both x and y position, or neither");
3165#endif
3166
3167 result = Qnil;
3168 if (geometry & XValue)
01f1ba30 3169 {
f83f10ba
RS		 3170 Lisp_Object element;
3171
e1d962d7
RS		 3172 if (x >= 0 && (geometry & XNegative))
3173 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3174 else if (x < 0 && ! (geometry & XNegative))
3175 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
f83f10ba
RS		 3176 else
3177 element = Fcons (Qleft, make_number (x));
3178 result = Fcons (element, result);
3179 }
3180
3181 if (geometry & YValue)
3182 {
3183 Lisp_Object element;
3184
e1d962d7
RS		 3185 if (y >= 0 && (geometry & YNegative))
3186 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3187 else if (y < 0 && ! (geometry & YNegative))
3188 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
f83f10ba
RS		 3189 else
3190 element = Fcons (Qtop, make_number (y));
3191 result = Fcons (element, result);
01f1ba30 3192 }
f83f10ba
RS		 3193
3194 if (geometry & WidthValue)
3195 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3196 if (geometry & HeightValue)
3197 result = Fcons (Fcons (Qheight, make_number (height)), result);
3198
3199 return result;
01f1ba30
JB		 3200}
3201
01f1ba30 3202/* Calculate the desired size and position of this window,
f83f10ba 3203 and return the flags saying which aspects were specified.
8fc2766b
RS		 3204
3205 This function does not make the coordinates positive. */
01f1ba30
JB		 3206
3207#define DEFAULT_ROWS 40
3208#define DEFAULT_COLS 80
3209
f9942c9e 3210static int
f676886a
JB		 3211x_figure_window_size (f, parms)
3212 struct frame *f;
01f1ba30
JB		 3213 Lisp_Object parms;
3214{
4fe1de12 3215 register Lisp_Object tem0, tem1, tem2;
01f1ba30 3216 long window_prompting = 0;
abb4b7ec 3217 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
01f1ba30
JB		 3218
3219 /* Default values if we fall through.
3220 Actually, if that happens we should get
b9dc4443 3221 window manager prompting. */
1ab3d87e 3222 SET_FRAME_WIDTH (f, DEFAULT_COLS);
f676886a 3223 f->height = DEFAULT_ROWS;
bd0b85c3
RS		 3224 /* Window managers expect that if program-specified
3225 positions are not (0,0), they're intentional, not defaults. */
7556890b
RS		 3226 f->output_data.x->top_pos = 0;
3227 f->output_data.x->left_pos = 0;
01f1ba30 3228
333b20bb
GM		 3229 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3230 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3231 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
f83f10ba 3232 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30 3233 {
f83f10ba
RS		 3234 if (!EQ (tem0, Qunbound))
3235 {
b7826503 3236 CHECK_NUMBER (tem0);
f83f10ba
RS		 3237 f->height = XINT (tem0);
3238 }
3239 if (!EQ (tem1, Qunbound))
3240 {
b7826503 3241 CHECK_NUMBER (tem1);
1ab3d87e 3242 SET_FRAME_WIDTH (f, XINT (tem1));
f83f10ba
RS		 3243 }
3244 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4fe1de12
RS		 3245 window_prompting |= USSize;
3246 else
3247 window_prompting |= PSize;
01f1ba30 3248 }
01f1ba30 3249
7556890b 3250 f->output_data.x->vertical_scroll_bar_extra
a444c70b
KH		 3251 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3252 ? 0
7556890b 3253 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
b3ba0aa8
KS		 3254
3255 x_compute_fringe_widths (f, 0);
3256
7556890b
RS		 3257 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3258 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
01f1ba30 3259
333b20bb
GM		 3260 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3261 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3262 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
f83f10ba 3263 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30 3264 {
f83f10ba
RS		 3265 if (EQ (tem0, Qminus))
3266 {
7556890b 3267 f->output_data.x->top_pos = 0;
f83f10ba
RS		 3268 window_prompting |= YNegative;
3269 }
8e713be6
KR		 3270 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3271 && CONSP (XCDR (tem0))
3272 && INTEGERP (XCAR (XCDR (tem0))))
e1d962d7 3273 {
8e713be6 3274 f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
e1d962d7
RS		 3275 window_prompting |= YNegative;
3276 }
8e713be6
KR		 3277 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3278 && CONSP (XCDR (tem0))
3279 && INTEGERP (XCAR (XCDR (tem0))))
e1d962d7 3280 {
8e713be6 3281 f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
e1d962d7 3282 }
f83f10ba 3283 else if (EQ (tem0, Qunbound))
7556890b 3284 f->output_data.x->top_pos = 0;
f83f10ba
RS		 3285 else
3286 {
b7826503 3287 CHECK_NUMBER (tem0);
7556890b
RS		 3288 f->output_data.x->top_pos = XINT (tem0);
3289 if (f->output_data.x->top_pos < 0)
f83f10ba
RS		 3290 window_prompting |= YNegative;
3291 }
3292
3293 if (EQ (tem1, Qminus))
3294 {
7556890b 3295 f->output_data.x->left_pos = 0;
f83f10ba
RS		 3296 window_prompting |= XNegative;
3297 }
8e713be6
KR		 3298 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3299 && CONSP (XCDR (tem1))
3300 && INTEGERP (XCAR (XCDR (tem1))))
e1d962d7 3301 {
8e713be6 3302 f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
e1d962d7
RS		 3303 window_prompting |= XNegative;
3304 }
8e713be6
KR		 3305 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3306 && CONSP (XCDR (tem1))
3307 && INTEGERP (XCAR (XCDR (tem1))))
e1d962d7 3308 {
8e713be6 3309 f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
e1d962d7 3310 }
f83f10ba 3311 else if (EQ (tem1, Qunbound))
7556890b 3312 f->output_data.x->left_pos = 0;
f83f10ba
RS		 3313 else
3314 {
b7826503 3315 CHECK_NUMBER (tem1);
7556890b
RS		 3316 f->output_data.x->left_pos = XINT (tem1);
3317 if (f->output_data.x->left_pos < 0)
f83f10ba
RS		 3318 window_prompting |= XNegative;
3319 }
3320
c3724dc2 3321 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4fe1de12
RS		 3322 window_prompting |= USPosition;
3323 else
3324 window_prompting |= PPosition;
01f1ba30 3325 }
f83f10ba 3326
49d41073
EZ		 3327 if (f->output_data.x->want_fullscreen != FULLSCREEN_NONE)
3328 {
3329 int left, top;
3330 int width, height;
3331
3332 /* It takes both for some WM:s to place it where we want */
3333 window_prompting = USPosition | PPosition;
3334 x_fullscreen_adjust (f, &width, &height, &top, &left);
3335 f->width = width;
3336 f->height = height;
3337 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3338 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
3339 f->output_data.x->left_pos = left;
3340 f->output_data.x->top_pos = top;
3341 }
3342
739f2f53 3343 return window_prompting;
01f1ba30
JB		 3344}
3345
f58534a3
RS		 3346#if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3347
3348Status
3349XSetWMProtocols (dpy, w, protocols, count)
3350 Display *dpy;
3351 Window w;
3352 Atom *protocols;
3353 int count;
3354{
3355 Atom prop;
3356 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
3357 if (prop == None) return False;
3358 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
3359 (unsigned char *) protocols, count);
3360 return True;
3361}
9ef48a9d
RS		 3362#endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3363\f
3364#ifdef USE_X_TOOLKIT
3365
8e3d10a9
RS		 3366/* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3367 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
59aa6c90
RS		 3368 already be present because of the toolkit (Motif adds some of them,
3369 for example, but Xt doesn't). */
9ef48a9d
RS		 3370
3371static void
b9dc4443
RS		 3372hack_wm_protocols (f, widget)
3373 FRAME_PTR f;
9ef48a9d
RS		 3374 Widget widget;
3375{
3376 Display *dpy = XtDisplay (widget);
3377 Window w = XtWindow (widget);
3378 int need_delete = 1;
3379 int need_focus = 1;
59aa6c90 3380 int need_save = 1;
9ef48a9d
RS		 3381
3382 BLOCK_INPUT;
3383 {
3384 Atom type, *atoms = 0;
3385 int format = 0;
3386 unsigned long nitems = 0;
3387 unsigned long bytes_after;
3388
270958e8
KH		 3389 if ((XGetWindowProperty (dpy, w,
3390 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
34d5ae1e 3391 (long)0, (long)100, False, XA_ATOM,
270958e8
KH		 3392 &type, &format, &nitems, &bytes_after,
3393 (unsigned char **) &atoms)
3394 == Success)
9ef48a9d
RS		 3395 && format == 32 && type == XA_ATOM)
3396 while (nitems > 0)
3397 {
3398 nitems--;
b9dc4443
RS		 3399 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
3400 need_delete = 0;
3401 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
3402 need_focus = 0;
3403 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
3404 need_save = 0;
9ef48a9d
RS		 3405 }
3406 if (atoms) XFree ((char *) atoms);
3407 }
3408 {
3409 Atom props [10];
3410 int count = 0;
b9dc4443
RS		 3411 if (need_delete)
3412 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3413 if (need_focus)
3414 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
3415 if (need_save)
3416 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
9ef48a9d 3417 if (count)
b9dc4443
RS		 3418 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3419 XA_ATOM, 32, PropModeAppend,
9ef48a9d
RS		 3420 (unsigned char *) props, count);
3421 }
3422 UNBLOCK_INPUT;
3423}
3424#endif
86779fac
GM		 3425
3426
5a7df7d7
GM		 3427\f
3428/* Support routines for XIC (X Input Context). */
86779fac 3429
5a7df7d7
GM		 3430#ifdef HAVE_X_I18N
3431
3432static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
3433static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
3434
3435
3436/* Supported XIM styles, ordered by preferenc. */
3437
3438static XIMStyle supported_xim_styles[] =
3439{
3440 XIMPreeditPosition | XIMStatusArea,
3441 XIMPreeditPosition | XIMStatusNothing,
3442 XIMPreeditPosition | XIMStatusNone,
3443 XIMPreeditNothing | XIMStatusArea,
3444 XIMPreeditNothing | XIMStatusNothing,
3445 XIMPreeditNothing | XIMStatusNone,
3446 XIMPreeditNone | XIMStatusArea,
3447 XIMPreeditNone | XIMStatusNothing,
3448 XIMPreeditNone | XIMStatusNone,
3449 0,
3450};
3451
3452
3453/* Create an X fontset on frame F with base font name
3454 BASE_FONTNAME.. */
3455
3456static XFontSet
3457xic_create_xfontset (f, base_fontname)
86779fac 3458 struct frame *f;
5a7df7d7 3459 char *base_fontname;
86779fac 3460{
5a7df7d7
GM		 3461 XFontSet xfs;
3462 char **missing_list;
3463 int missing_count;
3464 char *def_string;
86779fac 3465
5a7df7d7
GM		 3466 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
3467 base_fontname, &missing_list,
3468 &missing_count, &def_string);
3469 if (missing_list)
3470 XFreeStringList (missing_list);
3471
3472 /* No need to free def_string. */
3473 return xfs;
3474}
3475
3476
3477/* Value is the best input style, given user preferences USER (already
3478 checked to be supported by Emacs), and styles supported by the
3479 input method XIM. */
3480
3481static XIMStyle
3482best_xim_style (user, xim)
3483 XIMStyles *user;
3484 XIMStyles *xim;
3485{
3486 int i, j;
3487
3488 for (i = 0; i < user->count_styles; ++i)
3489 for (j = 0; j < xim->count_styles; ++j)
3490 if (user->supported_styles[i] == xim->supported_styles[j])
3491 return user->supported_styles[i];
3492
3493 /* Return the default style. */
3494 return XIMPreeditNothing | XIMStatusNothing;
3495}
3496
3497/* Create XIC for frame F. */
3498
5df79d3d
GM		 3499static XIMStyle xic_style;
3500
5a7df7d7
GM		 3501void
3502create_frame_xic (f)
3503 struct frame *f;
3504{
5a7df7d7
GM		 3505 XIM xim;
3506 XIC xic = NULL;
3507 XFontSet xfs = NULL;
86779fac 3508
5a7df7d7
GM		 3509 if (FRAME_XIC (f))
3510 return;
3511
3512 xim = FRAME_X_XIM (f);
3513 if (xim)
3514 {
d9d57cb2
DL		 3515 XRectangle s_area;
3516 XPoint spot;
5a7df7d7
GM		 3517 XVaNestedList preedit_attr;
3518 XVaNestedList status_attr;
3519 char *base_fontname;
3520 int fontset;
3521
d9d57cb2
DL		 3522 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
3523 spot.x = 0; spot.y = 1;
5a7df7d7
GM		 3524 /* Create X fontset. */
3525 fontset = FRAME_FONTSET (f);
3526 if (fontset < 0)
3527 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3528 else
3529 {
6ecb43ce
KH		 3530 /* Determine the base fontname from the ASCII font name of
3531 FONTSET. */
3532 char *ascii_font = (char *) XSTRING (fontset_ascii (fontset))->data;
3533 char *p = ascii_font;
5a7df7d7 3534 int i;
6ecb43ce
KH		 3535
3536 for (i = 0; *p; p++)
3537 if (*p == '-') i++;
3538 if (i != 14)
3539 /* As the font name doesn't conform to XLFD, we can't
3540 modify it to get a suitable base fontname for the
3541 frame. */
3542 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3543 else
3544 {
3545 int len = strlen (ascii_font) + 1;
8ec8a5ec 3546 char *p1 = NULL;
6ecb43ce
KH		 3547
3548 for (i = 0, p = ascii_font; i < 8; p++)
3549 {
3550 if (*p == '-')
3551 {
3552 i++;
3553 if (i == 3)
3554 p1 = p + 1;
3555 }
3556 }
3557 base_fontname = (char *) alloca (len);
3558 bzero (base_fontname, len);
3559 strcpy (base_fontname, "-*-*-");
3560 bcopy (p1, base_fontname + 5, p - p1);
3561 strcat (base_fontname, "*-*-*-*-*-*-*");
3562 }
5a7df7d7
GM		 3563 }
3564 xfs = xic_create_xfontset (f, base_fontname);
86779fac 3565
5a7df7d7
GM		 3566 /* Determine XIC style. */
3567 if (xic_style == 0)
3568 {
3569 XIMStyles supported_list;
3570 supported_list.count_styles = (sizeof supported_xim_styles
3571 / sizeof supported_xim_styles[0]);
3572 supported_list.supported_styles = supported_xim_styles;
3573 xic_style = best_xim_style (&supported_list,
3574 FRAME_X_XIM_STYLES (f));
3575 }
86779fac 3576
5a7df7d7
GM		 3577 preedit_attr = XVaCreateNestedList (0,
3578 XNFontSet, xfs,
3579 XNForeground,
3580 FRAME_FOREGROUND_PIXEL (f),
3581 XNBackground,
3582 FRAME_BACKGROUND_PIXEL (f),
3583 (xic_style & XIMPreeditPosition
3584 ? XNSpotLocation
3585 : NULL),
3586 &spot,
3587 NULL);
3588 status_attr = XVaCreateNestedList (0,
3589 XNArea,
3590 &s_area,
3591 XNFontSet,
3592 xfs,
3593 XNForeground,
3594 FRAME_FOREGROUND_PIXEL (f),
3595 XNBackground,
3596 FRAME_BACKGROUND_PIXEL (f),
3597 NULL);
3598
3599 xic = XCreateIC (xim,
3600 XNInputStyle, xic_style,
3601 XNClientWindow, FRAME_X_WINDOW(f),
3602 XNFocusWindow, FRAME_X_WINDOW(f),
3603 XNStatusAttributes, status_attr,
3604 XNPreeditAttributes, preedit_attr,
3605 NULL);
3606 XFree (preedit_attr);
3607 XFree (status_attr);
3608 }
3609
3610 FRAME_XIC (f) = xic;
3611 FRAME_XIC_STYLE (f) = xic_style;
3612 FRAME_XIC_FONTSET (f) = xfs;
86779fac
GM		 3613}
3614
5a7df7d7
GM		 3615
3616/* Destroy XIC and free XIC fontset of frame F, if any. */
3617
3618void
3619free_frame_xic (f)
3620 struct frame *f;
3621{
3622 if (FRAME_XIC (f) == NULL)
3623 return;
3624
3625 XDestroyIC (FRAME_XIC (f));
3626 if (FRAME_XIC_FONTSET (f))
3627 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3628
3629 FRAME_XIC (f) = NULL;
3630 FRAME_XIC_FONTSET (f) = NULL;
3631}
3632
3633
3634/* Place preedit area for XIC of window W's frame to specified
3635 pixel position X/Y. X and Y are relative to window W. */
3636
3637void
3638xic_set_preeditarea (w, x, y)
3639 struct window *w;
3640 int x, y;
3641{
3642 struct frame *f = XFRAME (w->frame);
3643 XVaNestedList attr;
3644 XPoint spot;
3645
3646 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
3647 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
3648 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
3649 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3650 XFree (attr);
3651}
3652
3653
3654/* Place status area for XIC in bottom right corner of frame F.. */
3655
3656void
3657xic_set_statusarea (f)
3658 struct frame *f;
3659{
3660 XIC xic = FRAME_XIC (f);
3661 XVaNestedList attr;
3662 XRectangle area;
3663 XRectangle *needed;
3664
3665 /* Negotiate geometry of status area. If input method has existing
3666 status area, use its current size. */
3667 area.x = area.y = area.width = area.height = 0;
3668 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
3669 XSetICValues (xic, XNStatusAttributes, attr, NULL);
3670 XFree (attr);
3671
3672 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
3673 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3674 XFree (attr);
3675
3676 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
3677 {
3678 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
3679 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3680 XFree (attr);
3681 }
3682
3683 area.width = needed->width;
3684 area.height = needed->height;
3685 area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
3686 area.y = (PIXEL_HEIGHT (f) - area.height
3687 - FRAME_MENUBAR_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f));
3688 XFree (needed);
3689
3690 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
3691 XSetICValues(xic, XNStatusAttributes, attr, NULL);
3692 XFree (attr);
3693}
3694
3695
3696/* Set X fontset for XIC of frame F, using base font name
3697 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3698
3699void
3700xic_set_xfontset (f, base_fontname)
3701 struct frame *f;
3702 char *base_fontname;
3703{
3704 XVaNestedList attr;
3705 XFontSet xfs;
3706
3707 xfs = xic_create_xfontset (f, base_fontname);
3708
3709 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
3710 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
3711 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3712 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
3713 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
3714 XFree (attr);
3715
3716 if (FRAME_XIC_FONTSET (f))
3717 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3718 FRAME_XIC_FONTSET (f) = xfs;
3719}
3720
3721#endif /* HAVE_X_I18N */
3722
3723
9ef48a9d 3724\f
8fc2766b
RS		 3725#ifdef USE_X_TOOLKIT
3726
3727/* Create and set up the X widget for frame F. */
f58534a3 3728
01f1ba30 3729static void
a7f7d550
FP		 3730x_window (f, window_prompting, minibuffer_only)
3731 struct frame *f;
3732 long window_prompting;
3733 int minibuffer_only;
01f1ba30 3734{
9ef48a9d 3735 XClassHint class_hints;
31ac8d8c
FP		 3736 XSetWindowAttributes attributes;
3737 unsigned long attribute_mask;
9ef48a9d
RS		 3738 Widget shell_widget;
3739 Widget pane_widget;
6c32dd68 3740 Widget frame_widget;
9ef48a9d
RS		 3741 Arg al [25];
3742 int ac;
3743
3744 BLOCK_INPUT;
3745
b7975ee4
KH		 3746 /* Use the resource name as the top-level widget name
3747 for looking up resources. Make a non-Lisp copy
3748 for the window manager, so GC relocation won't bother it.
3749
3750 Elsewhere we specify the window name for the window manager. */
3751
cca176a0 3752 {
b7975ee4
KH		 3753 char *str = (char *) XSTRING (Vx_resource_name)->data;
3754 f->namebuf = (char *) xmalloc (strlen (str) + 1);
cca176a0
KH		 3755 strcpy (f->namebuf, str);
3756 }
9ef48a9d
RS		 3757
3758 ac = 0;
3759 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
3760 XtSetArg (al[ac], XtNinput, 1); ac++;
97787173 3761 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
7556890b 3762 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
9b2956e2
GM		 3763 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3764 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3765 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
cca176a0 3766 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
7a994728 3767 applicationShellWidgetClass,
82c90203 3768 FRAME_X_DISPLAY (f), al, ac);
9ef48a9d 3769
7556890b 3770 f->output_data.x->widget = shell_widget;
9ef48a9d
RS		 3771 /* maybe_set_screen_title_format (shell_widget); */
3772
6c32dd68
PR		 3773 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
3774 (widget_value *) NULL,
3775 shell_widget, False,
3776 (lw_callback) NULL,
3777 (lw_callback) NULL,
b6e11efd 3778 (lw_callback) NULL,
6c32dd68 3779 (lw_callback) NULL);
9ef48a9d 3780
9b2956e2
GM		 3781 ac = 0;
3782 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3783 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3784 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3785 XtSetValues (pane_widget, al, ac);
7556890b 3786 f->output_data.x->column_widget = pane_widget;
a7f7d550 3787
9ef48a9d 3788 /* mappedWhenManaged to false tells to the paned window to not map/unmap
5e65b9ab 3789 the emacs screen when changing menubar. This reduces flickering. */
9ef48a9d
RS		 3790
3791 ac = 0;
3792 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3793 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
3794 XtSetArg (al[ac], XtNallowResize, 1); ac++;
3795 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
3796 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
9b2956e2
GM		 3797 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3798 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3799 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3800 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
3801 al, ac);
9ef48a9d 3802
7556890b 3803 f->output_data.x->edit_widget = frame_widget;
9ef48a9d 3804
6c32dd68 3805 XtManageChild (frame_widget);
a7f7d550
FP		 3806
3807 /* Do some needed geometry management. */
3808 {
3809 int len;
3810 char *tem, shell_position[32];
3811 Arg al[2];
3812 int ac = 0;
5031cc10 3813 int extra_borders = 0;
8fc2766b 3814 int menubar_size
7556890b
RS		 3815 = (f->output_data.x->menubar_widget
3816 ? (f->output_data.x->menubar_widget->core.height
3817 + f->output_data.x->menubar_widget->core.border_width)
8fc2766b 3818 : 0);
a7f7d550 3819
f7008aff
RS		 3820#if 0 /* Experimentally, we now get the right results
3821 for -geometry -0-0 without this. 24 Aug 96, rms. */
01cbdba5
RS		 3822 if (FRAME_EXTERNAL_MENU_BAR (f))
3823 {
dd254b21 3824 Dimension ibw = 0;
01cbdba5
RS		 3825 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
3826 menubar_size += ibw;
3827 }
f7008aff 3828#endif
01cbdba5 3829
7556890b 3830 f->output_data.x->menubar_height = menubar_size;
00983aba 3831
440b0bfd 3832#ifndef USE_LUCID
5031cc10
KH		 3833 /* Motif seems to need this amount added to the sizes
3834 specified for the shell widget. The Athena/Lucid widgets don't.
3835 Both conclusions reached experimentally. -- rms. */
440b0bfd
RS		 3836 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
3837 &extra_borders, NULL);
3838 extra_borders *= 2;
3839#endif
5031cc10 3840
97787173
RS		 3841 /* Convert our geometry parameters into a geometry string
3842 and specify it.
3843 Note that we do not specify here whether the position
3844 is a user-specified or program-specified one.
3845 We pass that information later, in x_wm_set_size_hints. */
3846 {
7556890b 3847 int left = f->output_data.x->left_pos;
97787173 3848 int xneg = window_prompting & XNegative;
7556890b 3849 int top = f->output_data.x->top_pos;
97787173
RS		 3850 int yneg = window_prompting & YNegative;
3851 if (xneg)
3852 left = -left;
3853 if (yneg)
3854 top = -top;
c760f47e
KH		 3855
3856 if (window_prompting & USPosition)
5031cc10
KH		 3857 sprintf (shell_position, "=%dx%d%c%d%c%d",
3858 PIXEL_WIDTH (f) + extra_borders,
3859 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
c760f47e
KH		 3860 (xneg ? '-' : '+'), left,
3861 (yneg ? '-' : '+'), top);
3862 else
5031cc10
KH		 3863 sprintf (shell_position, "=%dx%d",
3864 PIXEL_WIDTH (f) + extra_borders,
3865 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
97787173
RS		 3866 }
3867
a7f7d550 3868 len = strlen (shell_position) + 1;
77110caa
RS		 3869 /* We don't free this because we don't know whether
3870 it is safe to free it while the frame exists.
3871 It isn't worth the trouble of arranging to free it
3872 when the frame is deleted. */
a7f7d550
FP		 3873 tem = (char *) xmalloc (len);
3874 strncpy (tem, shell_position, len);
3875 XtSetArg (al[ac], XtNgeometry, tem); ac++;
3876 XtSetValues (shell_widget, al, ac);
3877 }
3878
9ef48a9d
RS		 3879 XtManageChild (pane_widget);
3880 XtRealizeWidget (shell_widget);
3881
6c32dd68 3882 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
9ef48a9d
RS		 3883
3884 validate_x_resource_name ();
b7975ee4 3885
9ef48a9d 3886 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
498e9ac3 3887 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
b9dc4443 3888 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
5a7df7d7
GM		 3889
3890#ifdef HAVE_X_I18N
3891 FRAME_XIC (f) = NULL;
4bd777b8 3892#ifdef USE_XIM
5a7df7d7 3893 create_frame_xic (f);
4bd777b8 3894#endif
5a7df7d7 3895#endif
64d16748 3896
7556890b
RS		 3897 f->output_data.x->wm_hints.input = True;
3898 f->output_data.x->wm_hints.flags |= InputHint;
b9dc4443 3899 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3900 &f->output_data.x->wm_hints);
b8228beb 3901
c4ec904f 3902 hack_wm_protocols (f, shell_widget);
9ef48a9d 3903
6c32dd68
PR		 3904#ifdef HACK_EDITRES
3905 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
3906#endif
3907
9ef48a9d 3908 /* Do a stupid property change to force the server to generate a
333b20bb 3909 PropertyNotify event so that the event_stream server timestamp will
9ef48a9d
RS		 3910 be initialized to something relevant to the time we created the window.
3911 */
6c32dd68 3912 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
b9dc4443
RS		 3913 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3914 XA_ATOM, 32, PropModeAppend,
9ef48a9d
RS		 3915 (unsigned char*) NULL, 0);
3916
5a7df7d7 3917 /* Make all the standard events reach the Emacs frame. */
31ac8d8c 3918 attributes.event_mask = STANDARD_EVENT_SET;
5a7df7d7
GM		 3919
3920#ifdef HAVE_X_I18N
3921 if (FRAME_XIC (f))
3922 {
3923 /* XIM server might require some X events. */
3924 unsigned long fevent = NoEventMask;
3925 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3926 attributes.event_mask |= fevent;
3927 }
3928#endif /* HAVE_X_I18N */
3929
31ac8d8c
FP		 3930 attribute_mask = CWEventMask;
3931 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
3932 attribute_mask, &attributes);
3933
6c32dd68 3934 XtMapWidget (frame_widget);
9ef48a9d 3935
8fc2766b
RS		 3936 /* x_set_name normally ignores requests to set the name if the
3937 requested name is the same as the current name. This is the one
3938 place where that assumption isn't correct; f->name is set, but
3939 the X server hasn't been told. */
3940 {
3941 Lisp_Object name;
3942 int explicit = f->explicit_name;
3943
3944 f->explicit_name = 0;
3945 name = f->name;
3946 f->name = Qnil;
3947 x_set_name (f, name, explicit);
3948 }
3949
b9dc4443 3950 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3951 f->output_data.x->text_cursor);
8fc2766b
RS		 3952
3953 UNBLOCK_INPUT;
3954
495fa05e
GM		 3955 /* This is a no-op, except under Motif. Make sure main areas are
3956 set to something reasonable, in case we get an error later. */
3957 lw_set_main_areas (pane_widget, 0, frame_widget);
8fc2766b
RS		 3958}
3959
9ef48a9d
RS		 3960#else /* not USE_X_TOOLKIT */
3961
8fc2766b
RS		 3962/* Create and set up the X window for frame F. */
3963
201d8c78 3964void
8fc2766b
RS		 3965x_window (f)
3966 struct frame *f;
3967
3968{
3969 XClassHint class_hints;
3970 XSetWindowAttributes attributes;
3971 unsigned long attribute_mask;
3972
7556890b
RS		 3973 attributes.background_pixel = f->output_data.x->background_pixel;
3974 attributes.border_pixel = f->output_data.x->border_pixel;
01f1ba30
JB		 3975 attributes.bit_gravity = StaticGravity;
3976 attributes.backing_store = NotUseful;
3977 attributes.save_under = True;
3978 attributes.event_mask = STANDARD_EVENT_SET;
9b2956e2
GM		 3979 attributes.colormap = FRAME_X_COLORMAP (f);
3980 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
3981 | CWColormap);
01f1ba30
JB		 3982
3983 BLOCK_INPUT;
fe24a618 3984 FRAME_X_WINDOW (f)
b9dc4443 3985 = XCreateWindow (FRAME_X_DISPLAY (f),
7556890b
RS		 3986 f->output_data.x->parent_desc,
3987 f->output_data.x->left_pos,
3988 f->output_data.x->top_pos,
f676886a 3989 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
7556890b 3990 f->output_data.x->border_width,
01f1ba30
JB		 3991 CopyFromParent, /* depth */
3992 InputOutput, /* class */
383d6ffc 3993 FRAME_X_VISUAL (f),
01f1ba30 3994 attribute_mask, &attributes);
5a7df7d7
GM		 3995
3996#ifdef HAVE_X_I18N
4bd777b8 3997#ifdef USE_XIM
5a7df7d7
GM		 3998 create_frame_xic (f);
3999 if (FRAME_XIC (f))
4000 {
4001 /* XIM server might require some X events. */
4002 unsigned long fevent = NoEventMask;
4003 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
4004 attributes.event_mask |= fevent;
4005 attribute_mask = CWEventMask;
4006 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4007 attribute_mask, &attributes);
4008 }
4bd777b8 4009#endif
5a7df7d7
GM		 4010#endif /* HAVE_X_I18N */
4011
d387c960 4012 validate_x_resource_name ();
b7975ee4 4013
d387c960 4014 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
498e9ac3 4015 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
b9dc4443 4016 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
01f1ba30 4017
00983aba
KH		 4018 /* The menubar is part of the ordinary display;
4019 it does not count in addition to the height of the window. */
7556890b 4020 f->output_data.x->menubar_height = 0;
00983aba 4021
179956b9
JB		 4022 /* This indicates that we use the "Passive Input" input model.
4023 Unless we do this, we don't get the Focus{In,Out} events that we
4024 need to draw the cursor correctly. Accursed bureaucrats.
b9dc4443 4025 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
179956b9 4026
7556890b
RS		 4027 f->output_data.x->wm_hints.input = True;
4028 f->output_data.x->wm_hints.flags |= InputHint;
b9dc4443 4029 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 4030 &f->output_data.x->wm_hints);
6d078211 4031 f->output_data.x->wm_hints.icon_pixmap = None;
179956b9 4032
032e4ebe
RS		 4033 /* Request "save yourself" and "delete window" commands from wm. */
4034 {
4035 Atom protocols[2];
b9dc4443
RS		 4036 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
4037 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
4038 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
032e4ebe 4039 }
9ef48a9d 4040
e373f201
JB		 4041 /* x_set_name normally ignores requests to set the name if the
4042 requested name is the same as the current name. This is the one
4043 place where that assumption isn't correct; f->name is set, but
4044 the X server hasn't been told. */
4045 {
98381190 4046 Lisp_Object name;
cf177271 4047 int explicit = f->explicit_name;
e373f201 4048
cf177271 4049 f->explicit_name = 0;
98381190
KH		 4050 name = f->name;
4051 f->name = Qnil;
cf177271 4052 x_set_name (f, name, explicit);
e373f201
JB		 4053 }
4054
b9dc4443 4055 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 4056 f->output_data.x->text_cursor);
9ef48a9d 4057
01f1ba30
JB		 4058 UNBLOCK_INPUT;
4059
fe24a618 4060 if (FRAME_X_WINDOW (f) == 0)
9ef48a9d 4061 error ("Unable to create window");
01f1ba30
JB		 4062}
4063
8fc2766b
RS		 4064#endif /* not USE_X_TOOLKIT */
4065
01f1ba30
JB		 4066/* Handle the icon stuff for this window. Perhaps later we might
4067 want an x_set_icon_position which can be called interactively as
b9dc4443 4068 well. */
01f1ba30
JB		 4069
4070static void
f676886a
JB		 4071x_icon (f, parms)
4072 struct frame *f;
01f1ba30
JB		 4073 Lisp_Object parms;
4074{
f9942c9e 4075 Lisp_Object icon_x, icon_y;
abb4b7ec 4076 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
01f1ba30
JB		 4077
4078 /* Set the position of the icon. Note that twm groups all
b9dc4443 4079 icons in an icon window. */
333b20bb
GM		 4080 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4081 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
f9942c9e 4082 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
01f1ba30 4083 {
b7826503
PJ		 4084 CHECK_NUMBER (icon_x);
4085 CHECK_NUMBER (icon_y);
01f1ba30 4086 }
f9942c9e 4087 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
01f1ba30 4088 error ("Both left and top icon corners of icon must be specified");
01f1ba30 4089
f9942c9e
JB		 4090 BLOCK_INPUT;
4091
fe24a618
JB		 4092 if (! EQ (icon_x, Qunbound))
4093 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
f9942c9e 4094
01f1ba30 4095 /* Start up iconic or window? */
49795535 4096 x_wm_set_window_state
333b20bb
GM		 4097 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
4098 Qicon)
49795535
JB		 4099 ? IconicState
4100 : NormalState));
01f1ba30 4101
f468da95
RS		 4102 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4103 ? f->icon_name
4104 : f->name))->data);
80534dd6 4105
01f1ba30
JB		 4106 UNBLOCK_INPUT;
4107}
4108
b243755a 4109/* Make the GCs needed for this window, setting the
01f1ba30
JB		 4110 background, border and mouse colors; also create the
4111 mouse cursor and the gray border tile. */
4112
f945b920
JB		 4113static char cursor_bits[] =
4114 {
4115 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4116 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4117 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4118 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4119 };
4120
01f1ba30 4121static void
f676886a
JB		 4122x_make_gc (f)
4123 struct frame *f;
01f1ba30
JB		 4124{
4125 XGCValues gc_values;
01f1ba30 4126
6afb1d07
JB		 4127 BLOCK_INPUT;
4128
b243755a 4129 /* Create the GCs of this frame.
9ef48a9d 4130 Note that many default values are used. */
01f1ba30
JB		 4131
4132 /* Normal video */
7556890b
RS		 4133 gc_values.font = f->output_data.x->font->fid;
4134 gc_values.foreground = f->output_data.x->foreground_pixel;
4135 gc_values.background = f->output_data.x->background_pixel;
9ef48a9d 4136 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
959e647d
GM		 4137 f->output_data.x->normal_gc
4138 = XCreateGC (FRAME_X_DISPLAY (f),
4139 FRAME_X_WINDOW (f),
4140 GCLineWidth | GCFont | GCForeground | GCBackground,
4141 &gc_values);
01f1ba30 4142
b9dc4443 4143 /* Reverse video style. */
7556890b
RS		 4144 gc_values.foreground = f->output_data.x->background_pixel;
4145 gc_values.background = f->output_data.x->foreground_pixel;
959e647d
GM		 4146 f->output_data.x->reverse_gc
4147 = XCreateGC (FRAME_X_DISPLAY (f),
4148 FRAME_X_WINDOW (f),
4149 GCFont | GCForeground | GCBackground | GCLineWidth,
4150 &gc_values);
01f1ba30 4151
9ef48a9d 4152 /* Cursor has cursor-color background, background-color foreground. */
7556890b
RS		 4153 gc_values.foreground = f->output_data.x->background_pixel;
4154 gc_values.background = f->output_data.x->cursor_pixel;
01f1ba30
JB		 4155 gc_values.fill_style = FillOpaqueStippled;
4156 gc_values.stipple
b9dc4443
RS		 4157 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4158 FRAME_X_DISPLAY_INFO (f)->root_window,
01f1ba30 4159 cursor_bits, 16, 16);
7556890b 4160 f->output_data.x->cursor_gc
b9dc4443 4161 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
01f1ba30 4162 (GCFont | GCForeground | GCBackground
ac1f48a4 4163 | GCFillStyle /* | GCStipple */ | GCLineWidth),
01f1ba30
JB		 4164 &gc_values);
4165
333b20bb
GM		 4166 /* Reliefs. */
4167 f->output_data.x->white_relief.gc = 0;
4168 f->output_data.x->black_relief.gc = 0;
4169
01f1ba30 4170 /* Create the gray border tile used when the pointer is not in
f676886a 4171 the frame. Since this depends on the frame's pixel values,
9ef48a9d 4172 this must be done on a per-frame basis. */
7556890b 4173 f->output_data.x->border_tile
d043f1a4 4174 = (XCreatePixmapFromBitmapData
b9dc4443 4175 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
d043f1a4 4176 gray_bits, gray_width, gray_height,
7556890b
RS		 4177 f->output_data.x->foreground_pixel,
4178 f->output_data.x->background_pixel,
ab452f99 4179 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
6afb1d07
JB		 4180
4181 UNBLOCK_INPUT;
01f1ba30 4182}
01f1ba30 4183
959e647d
GM		 4184
4185/* Free what was was allocated in x_make_gc. */
4186
4187void
4188x_free_gcs (f)
4189 struct frame *f;
4190{
4191 Display *dpy = FRAME_X_DISPLAY (f);
4192
4193 BLOCK_INPUT;
4194
4195 if (f->output_data.x->normal_gc)
4196 {
4197 XFreeGC (dpy, f->output_data.x->normal_gc);
4198 f->output_data.x->normal_gc = 0;
4199 }
4200
4201 if (f->output_data.x->reverse_gc)
4202 {
4203 XFreeGC (dpy, f->output_data.x->reverse_gc);
4204 f->output_data.x->reverse_gc = 0;
4205 }
4206
4207 if (f->output_data.x->cursor_gc)
4208 {
4209 XFreeGC (dpy, f->output_data.x->cursor_gc);
4210 f->output_data.x->cursor_gc = 0;
4211 }
4212
4213 if (f->output_data.x->border_tile)
4214 {
4215 XFreePixmap (dpy, f->output_data.x->border_tile);
4216 f->output_data.x->border_tile = 0;
4217 }
4218
4219 UNBLOCK_INPUT;
4220}
4221
4222
eaf1eea9
GM		 4223/* Handler for signals raised during x_create_frame and
4224 x_create_top_frame. FRAME is the frame which is partially
4225 constructed. */
4226
4227static Lisp_Object
4228unwind_create_frame (frame)
4229 Lisp_Object frame;
4230{
4231 struct frame *f = XFRAME (frame);
4232
4233 /* If frame is ``official'', nothing to do. */
4234 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4235 {
f1d2ce7f 4236#if GLYPH_DEBUG
eaf1eea9
GM		 4237 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4238#endif
4239
4240 x_free_frame_resources (f);
4241
4242 /* Check that reference counts are indeed correct. */
4243 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4244 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a 4245 return Qt;
eaf1eea9
GM		 4246 }
4247
4248 return Qnil;
4249}
4250
4251
f676886a 4252DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
01f1ba30 4253 1, 1, 0,
7ee72033 4254 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
c061c855
GM		 4255Returns an Emacs frame object.
4256ALIST is an alist of frame parameters.
4257If the parameters specify that the frame should not have a minibuffer,
4258and do not specify a specific minibuffer window to use,
4259then `default-minibuffer-frame' must be a frame whose minibuffer can
4260be shared by the new frame.
4261
7ee72033
MB		 4262This function is an internal primitive--use `make-frame' instead. */)
4263 (parms)
01f1ba30
JB		 4264 Lisp_Object parms;
4265{
f676886a 4266 struct frame *f;
2365c027 4267 Lisp_Object frame, tem;
01f1ba30
JB		 4268 Lisp_Object name;
4269 int minibuffer_only = 0;
4270 long window_prompting = 0;
4271 int width, height;
eaf1eea9 4272 int count = BINDING_STACK_SIZE ();
ecaca587 4273 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
b9dc4443 4274 Lisp_Object display;
333b20bb 4275 struct x_display_info *dpyinfo = NULL;
a59e4f3d 4276 Lisp_Object parent;
e557f19d 4277 struct kboard *kb;
01f1ba30 4278
11ae94fe 4279 check_x ();
01f1ba30 4280
b7975ee4
KH		 4281 /* Use this general default value to start with
4282 until we know if this frame has a specified name. */
4283 Vx_resource_name = Vinvocation_name;
4284
333b20bb 4285 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
b9dc4443
RS		 4286 if (EQ (display, Qunbound))
4287 display = Qnil;
4288 dpyinfo = check_x_display_info (display);
e557f19d
KH		 4289#ifdef MULTI_KBOARD
4290 kb = dpyinfo->kboard;
4291#else
4292 kb = &the_only_kboard;
4293#endif
b9dc4443 4294
333b20bb 4295 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
6a5e54e2 4296 if (!STRINGP (name)
cf177271
JB		 4297 && ! EQ (name, Qunbound)
4298 && ! NILP (name))
08a90d6a 4299 error ("Invalid frame name--not a string or nil");
01f1ba30 4300
b7975ee4
KH		 4301 if (STRINGP (name))
4302 Vx_resource_name = name;
4303
a59e4f3d 4304 /* See if parent window is specified. */
333b20bb 4305 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
a59e4f3d
RS		 4306 if (EQ (parent, Qunbound))
4307 parent = Qnil;
4308 if (! NILP (parent))
b7826503 4309 CHECK_NUMBER (parent);
a59e4f3d 4310
ecaca587
RS		 4311 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4312 /* No need to protect DISPLAY because that's not used after passing
4313 it to make_frame_without_minibuffer. */
4314 frame = Qnil;
4315 GCPRO4 (parms, parent, name, frame);
333b20bb
GM		 4316 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
4317 RES_TYPE_SYMBOL);
f9942c9e 4318 if (EQ (tem, Qnone) || NILP (tem))
2526c290 4319 f = make_frame_without_minibuffer (Qnil, kb, display);
f9942c9e 4320 else if (EQ (tem, Qonly))
01f1ba30 4321 {
f676886a 4322 f = make_minibuffer_frame ();
01f1ba30
JB		 4323 minibuffer_only = 1;
4324 }
6a5e54e2 4325 else if (WINDOWP (tem))
2526c290 4326 f = make_frame_without_minibuffer (tem, kb, display);
f9942c9e
JB		 4327 else
4328 f = make_frame (1);
01f1ba30 4329
ecaca587
RS		 4330 XSETFRAME (frame, f);
4331
a3c87d4e
JB		 4332 /* Note that X Windows does support scroll bars. */
4333 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
179956b9 4334
08a90d6a 4335 f->output_method = output_x_window;
7556890b
RS		 4336 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
4337 bzero (f->output_data.x, sizeof (struct x_output));
4338 f->output_data.x->icon_bitmap = -1;
0ecca023 4339 f->output_data.x->fontset = -1;
333b20bb
GM		 4340 f->output_data.x->scroll_bar_foreground_pixel = -1;
4341 f->output_data.x->scroll_bar_background_pixel = -1;
f15340b7
MB		 4342#ifdef USE_TOOLKIT_SCROLL_BARS
4343 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
4344 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
4345#endif /* USE_TOOLKIT_SCROLL_BARS */
eaf1eea9 4346 record_unwind_protect (unwind_create_frame, frame);
08a90d6a 4347
f468da95 4348 f->icon_name
333b20bb
GM		 4349 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
4350 RES_TYPE_STRING);
f468da95
RS		 4351 if (! STRINGP (f->icon_name))
4352 f->icon_name = Qnil;
80534dd6 4353
08a90d6a 4354 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 4355#if GLYPH_DEBUG
eaf1eea9
GM		 4356 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
4357 dpyinfo_refcount = dpyinfo->reference_count;
4358#endif /* GLYPH_DEBUG */
73410c76 4359#ifdef MULTI_KBOARD
e557f19d 4360 FRAME_KBOARD (f) = kb;
73410c76 4361#endif
08a90d6a 4362
9b2956e2
GM		 4363 /* These colors will be set anyway later, but it's important
4364 to get the color reference counts right, so initialize them! */
4365 {
4366 Lisp_Object black;
4367 struct gcpro gcpro1;
cefecbcf
GM		 4368
4369 /* Function x_decode_color can signal an error. Make
4370 sure to initialize color slots so that we won't try
4371 to free colors we haven't allocated. */
4372 f->output_data.x->foreground_pixel = -1;
4373 f->output_data.x->background_pixel = -1;
4374 f->output_data.x->cursor_pixel = -1;
4375 f->output_data.x->cursor_foreground_pixel = -1;
4376 f->output_data.x->border_pixel = -1;
4377 f->output_data.x->mouse_pixel = -1;
9b2956e2
GM		 4378
4379 black = build_string ("black");
4380 GCPRO1 (black);
4381 f->output_data.x->foreground_pixel
4382 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4383 f->output_data.x->background_pixel
4384 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4385 f->output_data.x->cursor_pixel
4386 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4387 f->output_data.x->cursor_foreground_pixel
4388 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4389 f->output_data.x->border_pixel
4390 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4391 f->output_data.x->mouse_pixel
4392 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4393 UNGCPRO;
4394 }
4395
a59e4f3d
RS		 4396 /* Specify the parent under which to make this X window. */
4397
4398 if (!NILP (parent))
4399 {
8c239ac3 4400 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
7556890b 4401 f->output_data.x->explicit_parent = 1;
a59e4f3d
RS		 4402 }
4403 else
4404 {
7556890b
RS		 4405 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4406 f->output_data.x->explicit_parent = 0;
a59e4f3d
RS		 4407 }
4408
cf177271
JB		 4409 /* Set the name; the functions to which we pass f expect the name to
4410 be set. */
4411 if (EQ (name, Qunbound) || NILP (name))
4412 {
08a90d6a 4413 f->name = build_string (dpyinfo->x_id_name);
cf177271
JB		 4414 f->explicit_name = 0;
4415 }
4416 else
4417 {
4418 f->name = name;
4419 f->explicit_name = 1;
9ef48a9d
RS		 4420 /* use the frame's title when getting resources for this frame. */
4421 specbind (Qx_resource_name, name);
cf177271 4422 }
01f1ba30 4423
01f1ba30
JB		 4424 /* Extract the window parameters from the supplied values
4425 that are needed to determine window geometry. */
d387c960
JB		 4426 {
4427 Lisp_Object font;
4428
333b20bb 4429 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
2ee3abaa 4430
6817eab4 4431 BLOCK_INPUT;
e5e548e3
RS		 4432 /* First, try whatever font the caller has specified. */
4433 if (STRINGP (font))
942ea06d 4434 {
49965a29 4435 tem = Fquery_fontset (font, Qnil);
477f8642
KH		 4436 if (STRINGP (tem))
4437 font = x_new_fontset (f, XSTRING (tem)->data);
942ea06d
KH		 4438 else
4439 font = x_new_font (f, XSTRING (font)->data);
4440 }
333b20bb 4441
e5e548e3 4442 /* Try out a font which we hope has bold and italic variations. */
333b20bb
GM		 4443 if (!STRINGP (font))
4444 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
e5e548e3 4445 if (!STRINGP (font))
a6ac02af 4446 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
e5e548e3 4447 if (! STRINGP (font))
a6ac02af 4448 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
e5e548e3
RS		 4449 if (! STRINGP (font))
4450 /* This was formerly the first thing tried, but it finds too many fonts
4451 and takes too long. */
4452 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4453 /* If those didn't work, look for something which will at least work. */
4454 if (! STRINGP (font))
a6ac02af 4455 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
6817eab4
JB		 4456 UNBLOCK_INPUT;
4457 if (! STRINGP (font))
e5e548e3
RS		 4458 font = build_string ("fixed");
4459
477f8642 4460 x_default_parameter (f, parms, Qfont, font,
333b20bb 4461 "font", "Font", RES_TYPE_STRING);
d387c960 4462 }
9ef48a9d 4463
e3881aa0 4464#ifdef USE_LUCID
82c90203
RS		 4465 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4466 whereby it fails to get any font. */
7556890b 4467 xlwmenu_default_font = f->output_data.x->font;
dd254b21 4468#endif
82c90203 4469
cf177271 4470 x_default_parameter (f, parms, Qborder_width, make_number (2),
333b20bb
GM		 4471 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4472
4e397688 4473 /* This defaults to 1 in order to match xterm. We recognize either
ddf768c3
JB		 4474 internalBorderWidth or internalBorder (which is what xterm calls
4475 it). */
4476 if (NILP (Fassq (Qinternal_border_width, parms)))
4477 {
4478 Lisp_Object value;
4479
abb4b7ec 4480 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
333b20bb 4481 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
ddf768c3
JB		 4482 if (! EQ (value, Qunbound))
4483 parms = Fcons (Fcons (Qinternal_border_width, value),
4484 parms);
4485 }
dca97592 4486 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
333b20bb
GM		 4487 "internalBorderWidth", "internalBorderWidth",
4488 RES_TYPE_NUMBER);
1ab3d87e 4489 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
333b20bb
GM		 4490 "verticalScrollBars", "ScrollBars",
4491 RES_TYPE_SYMBOL);
01f1ba30 4492
b9dc4443 4493 /* Also do the stuff which must be set before the window exists. */
cf177271 4494 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
333b20bb 4495 "foreground", "Foreground", RES_TYPE_STRING);
cf177271 4496 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
0b60fc91 4497 "background", "Background", RES_TYPE_STRING);
cf177271 4498 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
333b20bb 4499 "pointerColor", "Foreground", RES_TYPE_STRING);
cf177271 4500 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
333b20bb 4501 "cursorColor", "Foreground", RES_TYPE_STRING);
cf177271 4502 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
333b20bb 4503 "borderColor", "BorderColor", RES_TYPE_STRING);
d62c8769
GM		 4504 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
4505 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
563b67aa
GM		 4506 x_default_parameter (f, parms, Qline_spacing, Qnil,
4507 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
b3ba0aa8
KS		 4508 x_default_parameter (f, parms, Qleft_fringe, Qnil,
4509 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4510 x_default_parameter (f, parms, Qright_fringe, Qnil,
4511 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
333b20bb
GM		 4512
4513 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
4514 "scrollBarForeground",
4515 "ScrollBarForeground", 1);
4516 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
4517 "scrollBarBackground",
4518 "ScrollBarBackground", 0);
4519
4520 /* Init faces before x_default_parameter is called for scroll-bar
4521 parameters because that function calls x_set_scroll_bar_width,
4522 which calls change_frame_size, which calls Fset_window_buffer,
4523 which runs hooks, which call Fvertical_motion. At the end, we
4524 end up in init_iterator with a null face cache, which should not
4525 happen. */
4526 init_frame_faces (f);
4527
c7bcb20d 4528 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
333b20bb 4529 "menuBar", "MenuBar", RES_TYPE_NUMBER);
e33455ca 4530 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
333b20bb 4531 "toolBar", "ToolBar", RES_TYPE_NUMBER);
79873d50 4532 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
333b20bb
GM		 4533 "bufferPredicate", "BufferPredicate",
4534 RES_TYPE_SYMBOL);
c2304e02 4535 x_default_parameter (f, parms, Qtitle, Qnil,
333b20bb 4536 "title", "Title", RES_TYPE_STRING);
ea0a1f53
GM		 4537 x_default_parameter (f, parms, Qwait_for_wm, Qt,
4538 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
49d41073
EZ		 4539 x_default_parameter (f, parms, Qfullscreen, Qnil,
4540 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
90eb1019 4541
7556890b 4542 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
35f59f6b
GM		 4543
4544 /* Add the tool-bar height to the initial frame height so that the
4545 user gets a text display area of the size he specified with -g or
4546 via .Xdefaults. Later changes of the tool-bar height don't
4547 change the frame size. This is done so that users can create
4548 tall Emacs frames without having to guess how tall the tool-bar
4549 will get. */
4550 if (FRAME_TOOL_BAR_LINES (f))
4551 {
4552 int margin, relief, bar_height;
4553
8ed86491 4554 relief = (tool_bar_button_relief >= 0
35f59f6b
GM		 4555 ? tool_bar_button_relief
4556 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4557
4558 if (INTEGERP (Vtool_bar_button_margin)
4559 && XINT (Vtool_bar_button_margin) > 0)
4560 margin = XFASTINT (Vtool_bar_button_margin);
4561 else if (CONSP (Vtool_bar_button_margin)
4562 && INTEGERP (XCDR (Vtool_bar_button_margin))
4563 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4564 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4565 else
4566 margin = 0;
4567
4568 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4569 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
4570 }
4571
4572 /* Compute the size of the X window. */
f676886a 4573 window_prompting = x_figure_window_size (f, parms);
01f1ba30 4574
f83f10ba 4575 if (window_prompting & XNegative)
2365c027 4576 {
f83f10ba 4577 if (window_prompting & YNegative)
7556890b 4578 f->output_data.x->win_gravity = SouthEastGravity;
f83f10ba 4579 else
7556890b 4580 f->output_data.x->win_gravity = NorthEastGravity;
f83f10ba
RS		 4581 }
4582 else
4583 {
4584 if (window_prompting & YNegative)
7556890b 4585 f->output_data.x->win_gravity = SouthWestGravity;
f83f10ba 4586 else
7556890b 4587 f->output_data.x->win_gravity = NorthWestGravity;
2365c027
RS		 4588 }
4589
7556890b 4590 f->output_data.x->size_hint_flags = window_prompting;
38d22040 4591
495fa05e
GM		 4592 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4593 f->no_split = minibuffer_only || EQ (tem, Qt);
4594
6a1bcd01 4595 /* Create the X widget or window. */
a7f7d550
FP		 4596#ifdef USE_X_TOOLKIT
4597 x_window (f, window_prompting, minibuffer_only);
4598#else
f676886a 4599 x_window (f);
a7f7d550 4600#endif
495fa05e 4601
f676886a
JB		 4602 x_icon (f, parms);
4603 x_make_gc (f);
01f1ba30 4604
495fa05e
GM		 4605 /* Now consider the frame official. */
4606 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4607 Vframe_list = Fcons (frame, Vframe_list);
4608
f9942c9e
JB		 4609 /* We need to do this after creating the X window, so that the
4610 icon-creation functions can say whose icon they're describing. */
cf177271 4611 x_default_parameter (f, parms, Qicon_type, Qnil,
333b20bb 4612 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
f9942c9e 4613
cf177271 4614 x_default_parameter (f, parms, Qauto_raise, Qnil,
333b20bb 4615 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
cf177271 4616 x_default_parameter (f, parms, Qauto_lower, Qnil,
333b20bb 4617 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
dbc4e1c1 4618 x_default_parameter (f, parms, Qcursor_type, Qbox,
333b20bb 4619 "cursorType", "CursorType", RES_TYPE_SYMBOL);
28d7281d
GM		 4620 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4621 "scrollBarWidth", "ScrollBarWidth",
4622 RES_TYPE_NUMBER);
f9942c9e 4623
f676886a 4624 /* Dimensions, especially f->height, must be done via change_frame_size.
01f1ba30 4625 Change will not be effected unless different from the current
b9dc4443 4626 f->height. */
f676886a
JB		 4627 width = f->width;
4628 height = f->height;
6a1bcd01 4629
1ab3d87e
RS		 4630 f->height = 0;
4631 SET_FRAME_WIDTH (f, 0);
8938a4fb 4632 change_frame_size (f, height, width, 1, 0, 0);
d043f1a4 4633
4a967a9b
GM		 4634 /* Set up faces after all frame parameters are known. This call
4635 also merges in face attributes specified for new frames. If we
4636 don't do this, the `menu' face for instance won't have the right
4637 colors, and the menu bar won't appear in the specified colors for
4638 new frames. */
4639 call1 (Qface_set_after_frame_default, frame);
4640
495fa05e
GM		 4641#ifdef USE_X_TOOLKIT
4642 /* Create the menu bar. */
4643 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4644 {
4645 /* If this signals an error, we haven't set size hints for the
4646 frame and we didn't make it visible. */
4647 initialize_frame_menubar (f);
4648
4649 /* This is a no-op, except under Motif where it arranges the
4650 main window for the widgets on it. */
4651 lw_set_main_areas (f->output_data.x->column_widget,
4652 f->output_data.x->menubar_widget,
4653 f->output_data.x->edit_widget);
4654 }
4655#endif /* USE_X_TOOLKIT */
4656
4657 /* Tell the server what size and position, etc, we want, and how
4658 badly we want them. This should be done after we have the menu
4659 bar so that its size can be taken into account. */
01f1ba30 4660 BLOCK_INPUT;
7989f084 4661 x_wm_set_size_hint (f, window_prompting, 0);
01f1ba30
JB		 4662 UNBLOCK_INPUT;
4663
495fa05e
GM		 4664 /* Make the window appear on the frame and enable display, unless
4665 the caller says not to. However, with explicit parent, Emacs
4666 cannot control visibility, so don't try. */
7556890b 4667 if (! f->output_data.x->explicit_parent)
a59e4f3d
RS		 4668 {
4669 Lisp_Object visibility;
49795535 4670
333b20bb
GM		 4671 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
4672 RES_TYPE_SYMBOL);
a59e4f3d
RS		 4673 if (EQ (visibility, Qunbound))
4674 visibility = Qt;
49795535 4675
a59e4f3d
RS		 4676 if (EQ (visibility, Qicon))
4677 x_iconify_frame (f);
4678 else if (! NILP (visibility))
4679 x_make_frame_visible (f);
4680 else
4681 /* Must have been Qnil. */
4682 ;
4683 }
01f1ba30 4684
495fa05e 4685 UNGCPRO;
9e57df62
GM		 4686
4687 /* Make sure windows on this frame appear in calls to next-window
4688 and similar functions. */
4689 Vwindow_list = Qnil;
4690
9ef48a9d 4691 return unbind_to (count, frame);
01f1ba30
JB		 4692}
4693
eaf1eea9 4694
0d17d282
KH		 4695/* FRAME is used only to get a handle on the X display. We don't pass the
4696 display info directly because we're called from frame.c, which doesn't
4697 know about that structure. */
e4f79258 4698
87498171 4699Lisp_Object
0d17d282
KH		 4700x_get_focus_frame (frame)
4701 struct frame *frame;
87498171 4702{
0d17d282 4703 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
87498171 4704 Lisp_Object xfocus;
0d17d282 4705 if (! dpyinfo->x_focus_frame)
87498171
KH		 4706 return Qnil;
4707
0d17d282 4708 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
87498171
KH		 4709 return xfocus;
4710}
f0614854 4711
3decc1e7
GM		 4712
4713/* In certain situations, when the window manager follows a
4714 click-to-focus policy, there seems to be no way around calling
4715 XSetInputFocus to give another frame the input focus .
4716
4717 In an ideal world, XSetInputFocus should generally be avoided so
4718 that applications don't interfere with the window manager's focus
4719 policy. But I think it's okay to use when it's clearly done
4720 following a user-command. */
4721
4722DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
7ee72033
MB		 4723 doc: /* Set the input focus to FRAME.
4724FRAME nil means use the selected frame. */)
4725 (frame)
3decc1e7
GM		 4726 Lisp_Object frame;
4727{
4728 struct frame *f = check_x_frame (frame);
4729 Display *dpy = FRAME_X_DISPLAY (f);
4730 int count;
4731
4732 BLOCK_INPUT;
4733 count = x_catch_errors (dpy);
4734 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4735 RevertToParent, CurrentTime);
4736 x_uncatch_errors (dpy, count);
4737 UNBLOCK_INPUT;
4738
4739 return Qnil;
4740}
4741
f0614854 4742\f
2d764c78 4743DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
7ee72033
MB		 4744 doc: /* Internal function called by `color-defined-p', which see. */)
4745 (color, frame)
b9dc4443 4746 Lisp_Object color, frame;
e12d55b2 4747{
b9dc4443
RS		 4748 XColor foo;
4749 FRAME_PTR f = check_x_frame (frame);
e12d55b2 4750
b7826503 4751 CHECK_STRING (color);
b9dc4443 4752
2d764c78 4753 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
e12d55b2
RS		 4754 return Qt;
4755 else
4756 return Qnil;
4757}
4758
2d764c78 4759DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
7ee72033
MB		 4760 doc: /* Internal function called by `color-values', which see. */)
4761 (color, frame)
b9dc4443 4762 Lisp_Object color, frame;
01f1ba30 4763{
b9dc4443
RS		 4764 XColor foo;
4765 FRAME_PTR f = check_x_frame (frame);
4766
b7826503 4767 CHECK_STRING (color);
01f1ba30 4768
2d764c78 4769 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
57c82a63
RS		 4770 {
4771 Lisp_Object rgb[3];
4772
4773 rgb[0] = make_number (foo.red);
4774 rgb[1] = make_number (foo.green);
4775 rgb[2] = make_number (foo.blue);
4776 return Flist (3, rgb);
4777 }
01f1ba30
JB		 4778 else
4779 return Qnil;
4780}
4781
2d764c78 4782DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
7ee72033
MB		 4783 doc: /* Internal function called by `display-color-p', which see. */)
4784 (display)
08a90d6a 4785 Lisp_Object display;
01f1ba30 4786{
08a90d6a 4787 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 4788
b9dc4443 4789 if (dpyinfo->n_planes <= 2)
01f1ba30
JB		 4790 return Qnil;
4791
b9dc4443 4792 switch (dpyinfo->visual->class)
01f1ba30
JB		 4793 {
4794 case StaticColor:
4795 case PseudoColor:
4796 case TrueColor:
4797 case DirectColor:
4798 return Qt;
4799
4800 default:
4801 return Qnil;
4802 }
4803}
4804
d0c9d219 4805DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
c061c855 4806 0, 1, 0,
7ee72033 4807 doc: /* Return t if the X display supports shades of gray.
c061c855
GM		 4808Note that color displays do support shades of gray.
4809The optional argument DISPLAY specifies which display to ask about.
4810DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4811If omitted or nil, that stands for the selected frame's display. */)
4812 (display)
08a90d6a 4813 Lisp_Object display;
d0c9d219 4814{
08a90d6a 4815 struct x_display_info *dpyinfo = check_x_display_info (display);
d0c9d219 4816
ae6b58f9 4817 if (dpyinfo->n_planes <= 1)
b9dc4443
RS		 4818 return Qnil;
4819
ae6b58f9
RS		 4820 switch (dpyinfo->visual->class)
4821 {
4822 case StaticColor:
4823 case PseudoColor:
4824 case TrueColor:
4825 case DirectColor:
4826 case StaticGray:
4827 case GrayScale:
4828 return Qt;
4829
4830 default:
4831 return Qnil;
4832 }
d0c9d219
RS		 4833}
4834
41beb8fc 4835DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
c061c855 4836 0, 1, 0,
7ee72033 4837 doc: /* Returns the width in pixels of the X display DISPLAY.
c061c855
GM		 4838The optional argument DISPLAY specifies which display to ask about.
4839DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4840If omitted or nil, that stands for the selected frame's display. */)
4841 (display)
08a90d6a 4842 Lisp_Object display;
41beb8fc 4843{
08a90d6a 4844 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4845
4846 return make_number (dpyinfo->width);
41beb8fc
RS		 4847}
4848
4849DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
c061c855 4850 Sx_display_pixel_height, 0, 1, 0,
7ee72033 4851 doc: /* Returns the height in pixels of the X display DISPLAY.
c061c855
GM		 4852The optional argument DISPLAY specifies which display to ask about.
4853DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4854If omitted or nil, that stands for the selected frame's display. */)
4855 (display)
08a90d6a 4856 Lisp_Object display;
41beb8fc 4857{
08a90d6a 4858 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4859
4860 return make_number (dpyinfo->height);
41beb8fc
RS		 4861}
4862
4863DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
c061c855 4864 0, 1, 0,
7ee72033 4865 doc: /* Returns the number of bitplanes of the X display DISPLAY.
c061c855
GM		 4866The optional argument DISPLAY specifies which display to ask about.
4867DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4868If omitted or nil, that stands for the selected frame's display. */)
4869 (display)
08a90d6a 4870 Lisp_Object display;
41beb8fc 4871{
08a90d6a 4872 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4873
4874 return make_number (dpyinfo->n_planes);
41beb8fc
RS		 4875}
4876
4877DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
c061c855 4878 0, 1, 0,
7ee72033 4879 doc: /* Returns the number of color cells of the X display DISPLAY.
c061c855
GM		 4880The optional argument DISPLAY specifies which display to ask about.
4881DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4882If omitted or nil, that stands for the selected frame's display. */)
4883 (display)
08a90d6a 4884 Lisp_Object display;
41beb8fc 4885{
08a90d6a 4886 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4887
4888 return make_number (DisplayCells (dpyinfo->display,
4889 XScreenNumberOfScreen (dpyinfo->screen)));
41beb8fc
RS		 4890}
4891
9d317b2c
RS		 4892DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4893 Sx_server_max_request_size,
c061c855 4894 0, 1, 0,
7ee72033 4895 doc: /* Returns the maximum request size of the X server of display DISPLAY.
c061c855
GM		 4896The optional argument DISPLAY specifies which display to ask about.
4897DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4898If omitted or nil, that stands for the selected frame's display. */)
4899 (display)
08a90d6a 4900 Lisp_Object display;
9d317b2c 4901{
08a90d6a 4902 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4903
4904 return make_number (MAXREQUEST (dpyinfo->display));
9d317b2c
RS		 4905}
4906
41beb8fc 4907DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
7ee72033 4908 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
c061c855
GM		 4909The optional argument DISPLAY specifies which display to ask about.
4910DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4911If omitted or nil, that stands for the selected frame's display. */)
4912 (display)
08a90d6a 4913 Lisp_Object display;
41beb8fc 4914{
08a90d6a 4915 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4916 char *vendor = ServerVendor (dpyinfo->display);
4917
41beb8fc
RS		 4918 if (! vendor) vendor = "";
4919 return build_string (vendor);
4920}
4921
4922DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
7ee72033 4923 doc: /* Returns the version numbers of the X server of display DISPLAY.
c061c855
GM		 4924The value is a list of three integers: the major and minor
4925version numbers of the X Protocol in use, and the vendor-specific release
4926number. See also the function `x-server-vendor'.
4927
4928The optional argument DISPLAY specifies which display to ask about.
4929DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4930If omitted or nil, that stands for the selected frame's display. */)
4931 (display)
08a90d6a 4932 Lisp_Object display;
41beb8fc 4933{
08a90d6a 4934 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443 4935 Display *dpy = dpyinfo->display;
11ae94fe 4936
41beb8fc
RS		 4937 return Fcons (make_number (ProtocolVersion (dpy)),
4938 Fcons (make_number (ProtocolRevision (dpy)),
4939 Fcons (make_number (VendorRelease (dpy)), Qnil)));
4940}
4941
4942DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
7ee72033 4943 doc: /* Return the number of screens on the X server of display DISPLAY.
c061c855
GM		 4944The optional argument DISPLAY specifies which display to ask about.
4945DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4946If omitted or nil, that stands for the selected frame's display. */)
4947 (display)
08a90d6a 4948 Lisp_Object display;
41beb8fc 4949{
08a90d6a 4950 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4951
4952 return make_number (ScreenCount (dpyinfo->display));
41beb8fc
RS		 4953}
4954
4955DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
7ee72033 4956 doc: /* Return the height in millimeters of the X display DISPLAY.
c061c855
GM		 4957The optional argument DISPLAY specifies which display to ask about.
4958DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4959If omitted or nil, that stands for the selected frame's display. */)
4960 (display)
08a90d6a 4961 Lisp_Object display;
41beb8fc 4962{
08a90d6a 4963 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4964
4965 return make_number (HeightMMOfScreen (dpyinfo->screen));
41beb8fc
RS		 4966}
4967
4968DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
7ee72033 4969 doc: /* Return the width in millimeters of the X display DISPLAY.
c061c855
GM		 4970The optional argument DISPLAY specifies which display to ask about.
4971DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4972If omitted or nil, that stands for the selected frame's display. */)
4973 (display)
08a90d6a 4974 Lisp_Object display;
41beb8fc 4975{
08a90d6a 4976 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4977
4978 return make_number (WidthMMOfScreen (dpyinfo->screen));
41beb8fc
RS		 4979}
4980
4981DEFUN ("x-display-backing-store", Fx_display_backing_store,
c061c855 4982 Sx_display_backing_store, 0, 1, 0,
7ee72033 4983 doc: /* Returns an indication of whether X display DISPLAY does backing store.
c061c855
GM		 4984The value may be `always', `when-mapped', or `not-useful'.
4985The optional argument DISPLAY specifies which display to ask about.
4986DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4987If omitted or nil, that stands for the selected frame's display. */)
4988 (display)
08a90d6a 4989 Lisp_Object display;
41beb8fc 4990{
08a90d6a 4991 struct x_display_info *dpyinfo = check_x_display_info (display);
8ec8a5ec 4992 Lisp_Object result;
11ae94fe 4993
b9dc4443 4994 switch (DoesBackingStore (dpyinfo->screen))
41beb8fc
RS		 4995 {
4996 case Always:
8ec8a5ec
GM		 4997 result = intern ("always");
4998 break;
41beb8fc
RS		 4999
5000 case WhenMapped:
8ec8a5ec
GM		 5001 result = intern ("when-mapped");
5002 break;
41beb8fc
RS		 5003
5004 case NotUseful:
8ec8a5ec
GM		 5005 result = intern ("not-useful");
5006 break;
41beb8fc
RS		 5007
5008 default:
5009 error ("Strange value for BackingStore parameter of screen");
8ec8a5ec 5010 result = Qnil;
41beb8fc 5011 }
8ec8a5ec
GM		 5012
5013 return result;
41beb8fc
RS		 5014}
5015
5016DEFUN ("x-display-visual-class", Fx_display_visual_class,
c061c855 5017 Sx_display_visual_class, 0, 1, 0,
7ee72033 5018 doc: /* Return the visual class of the X display DISPLAY.
c061c855
GM		 5019The value is one of the symbols `static-gray', `gray-scale',
5020`static-color', `pseudo-color', `true-color', or `direct-color'.
5021
5022The optional argument DISPLAY specifies which display to ask about.
5023DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5024If omitted or nil, that stands for the selected frame's display. */)
5025 (display)
08a90d6a 5026 Lisp_Object display;
41beb8fc 5027{
08a90d6a 5028 struct x_display_info *dpyinfo = check_x_display_info (display);
8ec8a5ec 5029 Lisp_Object result;
11ae94fe 5030
b9dc4443 5031 switch (dpyinfo->visual->class)
41beb8fc 5032 {
8ec8a5ec
GM		 5033 case StaticGray:
5034 result = intern ("static-gray");
5035 break;
5036 case GrayScale:
5037 result = intern ("gray-scale");
5038 break;
5039 case StaticColor:
5040 result = intern ("static-color");
5041 break;
5042 case PseudoColor:
5043 result = intern ("pseudo-color");
5044 break;
5045 case TrueColor:
5046 result = intern ("true-color");
5047 break;
5048 case DirectColor:
5049 result = intern ("direct-color");
5050 break;
41beb8fc
RS		 5051 default:
5052 error ("Display has an unknown visual class");
8ec8a5ec 5053 result = Qnil;
41beb8fc 5054 }
8ec8a5ec
GM		 5055
5056 return result;
41beb8fc
RS		 5057}
5058
5059DEFUN ("x-display-save-under", Fx_display_save_under,
c061c855 5060 Sx_display_save_under, 0, 1, 0,
7ee72033 5061 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
c061c855
GM		 5062The optional argument DISPLAY specifies which display to ask about.
5063DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5064If omitted or nil, that stands for the selected frame's display. */)
5065 (display)
08a90d6a 5066 Lisp_Object display;
41beb8fc 5067{
08a90d6a 5068 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 5069
b9dc4443 5070 if (DoesSaveUnders (dpyinfo->screen) == True)
41beb8fc
RS		 5071 return Qt;
5072 else
5073 return Qnil;
5074}
5075\f
b9dc4443 5076int
55caf99c
RS		 5077x_pixel_width (f)
5078 register struct frame *f;
01f1ba30 5079{
55caf99c 5080 return PIXEL_WIDTH (f);
01f1ba30
JB		 5081}
5082
b9dc4443 5083int
55caf99c
RS		 5084x_pixel_height (f)
5085 register struct frame *f;
01f1ba30 5086{
55caf99c
RS		 5087 return PIXEL_HEIGHT (f);
5088}
5089
b9dc4443 5090int
55caf99c
RS		 5091x_char_width (f)
5092 register struct frame *f;
5093{
7556890b 5094 return FONT_WIDTH (f->output_data.x->font);
55caf99c
RS		 5095}
5096
b9dc4443 5097int
55caf99c
RS		 5098x_char_height (f)
5099 register struct frame *f;
5100{
7556890b 5101 return f->output_data.x->line_height;
01f1ba30 5102}
b9dc4443
RS		 5103
5104int
f03f2489
RS		 5105x_screen_planes (f)
5106 register struct frame *f;
b9dc4443 5107{
f03f2489 5108 return FRAME_X_DISPLAY_INFO (f)->n_planes;
b9dc4443 5109}
01f1ba30 5110
a6ad00c0
GM		 5111
5112\f
5113/************************************************************************
5114 X Displays
5115 ************************************************************************/
5116
01f1ba30 5117\f
a6ad00c0
GM		 5118/* Mapping visual names to visuals. */
5119
5120static struct visual_class
5121{
5122 char *name;
5123 int class;
5124}
5125visual_classes[] =
5126{
5127 {"StaticGray", StaticGray},
5128 {"GrayScale", GrayScale},
5129 {"StaticColor", StaticColor},
5130 {"PseudoColor", PseudoColor},
5131 {"TrueColor", TrueColor},
5132 {"DirectColor", DirectColor},
9908a324 5133 {NULL, 0}
a6ad00c0
GM		 5134};
5135
5136
404daac1 5137#ifndef HAVE_XSCREENNUMBEROFSCREEN
a6ad00c0
GM		 5138
5139/* Value is the screen number of screen SCR. This is a substitute for
5140 the X function with the same name when that doesn't exist. */
5141
404daac1
RS		 5142int
5143XScreenNumberOfScreen (scr)
5144 register Screen *scr;
5145{
a6ad00c0
GM		 5146 Display *dpy = scr->display;
5147 int i;
3df34fdb 5148
a6ad00c0 5149 for (i = 0; i < dpy->nscreens; ++i)
fbd5ceb2 5150 if (scr == dpy->screens + i)
a6ad00c0 5151 break;
404daac1 5152
a6ad00c0 5153 return i;
404daac1 5154}
a6ad00c0 5155
404daac1
RS		 5156#endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5157
01f1ba30 5158
a6ad00c0
GM		 5159/* Select the visual that should be used on display DPYINFO. Set
5160 members of DPYINFO appropriately. Called from x_term_init. */
fe24a618 5161
a6ad00c0
GM		 5162void
5163select_visual (dpyinfo)
5164 struct x_display_info *dpyinfo;
5165{
5166 Display *dpy = dpyinfo->display;
5167 Screen *screen = dpyinfo->screen;
5168 Lisp_Object value;
fe24a618 5169
a6ad00c0
GM		 5170 /* See if a visual is specified. */
5171 value = display_x_get_resource (dpyinfo,
5172 build_string ("visualClass"),
5173 build_string ("VisualClass"),
5174 Qnil, Qnil);
5175 if (STRINGP (value))
5176 {
5177 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5178 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5179 depth, a decimal number. NAME is compared with case ignored. */
5180 char *s = (char *) alloca (STRING_BYTES (XSTRING (value)) + 1);
5181 char *dash;
5182 int i, class = -1;
5183 XVisualInfo vinfo;
5184
5185 strcpy (s, XSTRING (value)->data);
5186 dash = index (s, '-');
5187 if (dash)
5188 {
5189 dpyinfo->n_planes = atoi (dash + 1);
5190 *dash = '\0';
5191 }
5192 else
5193 /* We won't find a matching visual with depth 0, so that
5194 an error will be printed below. */
5195 dpyinfo->n_planes = 0;
f0614854 5196
a6ad00c0
GM		 5197 /* Determine the visual class. */
5198 for (i = 0; visual_classes[i].name; ++i)
5199 if (xstricmp (s, visual_classes[i].name) == 0)
5200 {
5201 class = visual_classes[i].class;
5202 break;
5203 }
01f1ba30 5204
a6ad00c0
GM		 5205 /* Look up a matching visual for the specified class. */
5206 if (class == -1
5207 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
5208 dpyinfo->n_planes, class, &vinfo))
5209 fatal ("Invalid visual specification `%s'", XSTRING (value)->data);
5210
5211 dpyinfo->visual = vinfo.visual;
5212 }
01f1ba30
JB		 5213 else
5214 {
a6ad00c0
GM		 5215 int n_visuals;
5216 XVisualInfo *vinfo, vinfo_template;
5217
5218 dpyinfo->visual = DefaultVisualOfScreen (screen);
5219
5220#ifdef HAVE_X11R4
5221 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
5222#else
5223 vinfo_template.visualid = dpyinfo->visual->visualid;
5224#endif
5225 vinfo_template.screen = XScreenNumberOfScreen (screen);
5226 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
5227 &vinfo_template, &n_visuals);
5228 if (n_visuals != 1)
5229 fatal ("Can't get proper X visual info");
5230
94ac875b 5231 dpyinfo->n_planes = vinfo->depth;
a6ad00c0
GM		 5232 XFree ((char *) vinfo);
5233 }
01f1ba30 5234}
01f1ba30 5235
a6ad00c0 5236
b9dc4443
RS		 5237/* Return the X display structure for the display named NAME.
5238 Open a new connection if necessary. */
5239
5240struct x_display_info *
5241x_display_info_for_name (name)
5242 Lisp_Object name;
5243{
08a90d6a 5244 Lisp_Object names;
b9dc4443
RS		 5245 struct x_display_info *dpyinfo;
5246
b7826503 5247 CHECK_STRING (name);
b9dc4443 5248
806048df
RS		 5249 if (! EQ (Vwindow_system, intern ("x")))
5250 error ("Not using X Windows");
5251
08a90d6a
RS		 5252 for (dpyinfo = x_display_list, names = x_display_name_list;
5253 dpyinfo;
8e713be6 5254 dpyinfo = dpyinfo->next, names = XCDR (names))
b9dc4443
RS		 5255 {
5256 Lisp_Object tem;
8e713be6 5257 tem = Fstring_equal (XCAR (XCAR (names)), name);
08a90d6a 5258 if (!NILP (tem))
b9dc4443
RS		 5259 return dpyinfo;
5260 }
5261
b7975ee4
KH		 5262 /* Use this general default value to start with. */
5263 Vx_resource_name = Vinvocation_name;
5264
b9dc4443
RS		 5265 validate_x_resource_name ();
5266
9b207e8e 5267 dpyinfo = x_term_init (name, (char *)0,
b7975ee4 5268 (char *) XSTRING (Vx_resource_name)->data);
b9dc4443 5269
08a90d6a 5270 if (dpyinfo == 0)
1b4ec1c8 5271 error ("Cannot connect to X server %s", XSTRING (name)->data);
08a90d6a 5272
b9dc4443
RS		 5273 x_in_use = 1;
5274 XSETFASTINT (Vwindow_system_version, 11);
5275
5276 return dpyinfo;
5277}
5278
a6ad00c0 5279
01f1ba30 5280DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
c061c855 5281 1, 3, 0,
7ee72033 5282 doc: /* Open a connection to an X server.
c061c855
GM		 5283DISPLAY is the name of the display to connect to.
5284Optional second arg XRM-STRING is a string of resources in xrdb format.
5285If the optional third arg MUST-SUCCEED is non-nil,
7ee72033
MB		 5286terminate Emacs if we can't open the connection. */)
5287 (display, xrm_string, must_succeed)
08a90d6a 5288 Lisp_Object display, xrm_string, must_succeed;
01f1ba30 5289{
01f1ba30 5290 unsigned char *xrm_option;
b9dc4443 5291 struct x_display_info *dpyinfo;
01f1ba30 5292
b7826503 5293 CHECK_STRING (display);
d387c960 5294 if (! NILP (xrm_string))
b7826503 5295 CHECK_STRING (xrm_string);
01f1ba30 5296
806048df
RS		 5297 if (! EQ (Vwindow_system, intern ("x")))
5298 error ("Not using X Windows");
5299
d387c960
JB		 5300 if (! NILP (xrm_string))
5301 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
01f1ba30
JB		 5302 else
5303 xrm_option = (unsigned char *) 0;
d387c960
JB		 5304
5305 validate_x_resource_name ();
5306
e1b1bee8 5307 /* This is what opens the connection and sets x_current_display.
b9dc4443
RS		 5308 This also initializes many symbols, such as those used for input. */
5309 dpyinfo = x_term_init (display, xrm_option,
b7975ee4 5310 (char *) XSTRING (Vx_resource_name)->data);
f1c16f36 5311
08a90d6a
RS		 5312 if (dpyinfo == 0)
5313 {
5314 if (!NILP (must_succeed))
10ffbc14
GM		 5315 fatal ("Cannot connect to X server %s.\n\
5316Check the DISPLAY environment variable or use `-d'.\n\
5317Also use the `xhost' program to verify that it is set to permit\n\
1b4ec1c8 5318connections from your machine.\n",
08a90d6a
RS		 5319 XSTRING (display)->data);
5320 else
1b4ec1c8 5321 error ("Cannot connect to X server %s", XSTRING (display)->data);
08a90d6a
RS		 5322 }
5323
b9dc4443 5324 x_in_use = 1;
01f1ba30 5325
b9dc4443 5326 XSETFASTINT (Vwindow_system_version, 11);
01f1ba30
JB		 5327 return Qnil;
5328}
5329
08a90d6a
RS		 5330DEFUN ("x-close-connection", Fx_close_connection,
5331 Sx_close_connection, 1, 1, 0,
7ee72033 5332 doc: /* Close the connection to DISPLAY's X server.
c061c855 5333For DISPLAY, specify either a frame or a display name (a string).
7ee72033
MB		 5334If DISPLAY is nil, that stands for the selected frame's display. */)
5335 (display)
c061c855 5336 Lisp_Object display;
01f1ba30 5337{
08a90d6a 5338 struct x_display_info *dpyinfo = check_x_display_info (display);
08a90d6a 5339 int i;
3457bc6e 5340
08a90d6a
RS		 5341 if (dpyinfo->reference_count > 0)
5342 error ("Display still has frames on it");
01f1ba30 5343
08a90d6a
RS		 5344 BLOCK_INPUT;
5345 /* Free the fonts in the font table. */
5346 for (i = 0; i < dpyinfo->n_fonts; i++)
333b20bb
GM		 5347 if (dpyinfo->font_table[i].name)
5348 {
6ecb43ce
KH		 5349 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
5350 xfree (dpyinfo->font_table[i].full_name);
333b20bb 5351 xfree (dpyinfo->font_table[i].name);
333b20bb
GM		 5352 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5353 }
5354
08a90d6a
RS		 5355 x_destroy_all_bitmaps (dpyinfo);
5356 XSetCloseDownMode (dpyinfo->display, DestroyAll);
82c90203
RS		 5357
5358#ifdef USE_X_TOOLKIT
5359 XtCloseDisplay (dpyinfo->display);
5360#else
08a90d6a 5361 XCloseDisplay (dpyinfo->display);
82c90203 5362#endif
08a90d6a
RS		 5363
5364 x_delete_display (dpyinfo);
5365 UNBLOCK_INPUT;
3457bc6e 5366
01f1ba30
JB		 5367 return Qnil;
5368}
5369
08a90d6a 5370DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
7ee72033
MB		 5371 doc: /* Return the list of display names that Emacs has connections to. */)
5372 ()
08a90d6a
RS		 5373{
5374 Lisp_Object tail, result;
5375
5376 result = Qnil;
8e713be6
KR		 5377 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
5378 result = Fcons (XCAR (XCAR (tail)), result);
08a90d6a
RS		 5379
5380 return result;
5381}
5382
5383DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7ee72033 5384 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
c061c855
GM		 5385If ON is nil, allow buffering of requests.
5386Turning on synchronization prohibits the Xlib routines from buffering
5387requests and seriously degrades performance, but makes debugging much
5388easier.
5389The optional second argument DISPLAY specifies which display to act on.
5390DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5391If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5392 (on, display)
08a90d6a 5393 Lisp_Object display, on;
01f1ba30 5394{
08a90d6a 5395 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 5396
b9dc4443 5397 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
01f1ba30
JB		 5398
5399 return Qnil;
5400}
5401
b9dc4443 5402/* Wait for responses to all X commands issued so far for frame F. */
6b7b1820
RS		 5403
5404void
b9dc4443
RS		 5405x_sync (f)
5406 FRAME_PTR f;
6b7b1820 5407{
4e87f4d2 5408 BLOCK_INPUT;
b9dc4443 5409 XSync (FRAME_X_DISPLAY (f), False);
4e87f4d2 5410 UNBLOCK_INPUT;
6b7b1820 5411}
333b20bb 5412
01f1ba30 5413\f
333b20bb
GM		 5414/***********************************************************************
5415 Image types
5416 ***********************************************************************/
f1c16f36 5417
333b20bb
GM		 5418/* Value is the number of elements of vector VECTOR. */
5419
5420#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5421
5422/* List of supported image types. Use define_image_type to add new
5423 types. Use lookup_image_type to find a type for a given symbol. */
5424
5425static struct image_type *image_types;
5426
333b20bb
GM		 5427/* The symbol `image' which is the car of the lists used to represent
5428 images in Lisp. */
5429
5430extern Lisp_Object Qimage;
5431
5432/* The symbol `xbm' which is used as the type symbol for XBM images. */
5433
5434Lisp_Object Qxbm;
5435
5436/* Keywords. */
5437
0fe92f72 5438extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
90ebdb19
GM		 5439extern Lisp_Object QCdata;
5440Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
d2dc8167 5441Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4a8e312c 5442Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
333b20bb
GM		 5443
5444/* Other symbols. */
5445
4a8e312c 5446Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
333b20bb
GM		 5447
5448/* Time in seconds after which images should be removed from the cache
5449 if not displayed. */
5450
fcf431dc 5451Lisp_Object Vimage_cache_eviction_delay;
333b20bb
GM		 5452
5453/* Function prototypes. */
5454
5455static void define_image_type P_ ((struct image_type *type));
5456static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
5457static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
5458static void x_laplace P_ ((struct frame *, struct image *));
4a8e312c 5459static void x_emboss P_ ((struct frame *, struct image *));
45158a91
GM		 5460static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
5461 Lisp_Object));
333b20bb
GM		 5462
5463
5464/* Define a new image type from TYPE. This adds a copy of TYPE to
5465 image_types and adds the symbol *TYPE->type to Vimage_types. */
5466
5467static void
5468define_image_type (type)
5469 struct image_type *type;
5470{
5471 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5472 The initialized data segment is read-only. */
5473 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
5474 bcopy (type, p, sizeof *p);
5475 p->next = image_types;
5476 image_types = p;
5477 Vimage_types = Fcons (*p->type, Vimage_types);
5478}
5479
5480
5481/* Look up image type SYMBOL, and return a pointer to its image_type
5482 structure. Value is null if SYMBOL is not a known image type. */
5483
5484static INLINE struct image_type *
5485lookup_image_type (symbol)
5486 Lisp_Object symbol;
5487{
5488 struct image_type *type;
5489
5490 for (type = image_types; type; type = type->next)
5491 if (EQ (symbol, *type->type))
5492 break;
5493
5494 return type;
5495}
5496
5497
5498/* Value is non-zero if OBJECT is a valid Lisp image specification. A
5499 valid image specification is a list whose car is the symbol
5500 `image', and whose rest is a property list. The property list must
5501 contain a value for key `:type'. That value must be the name of a
5502 supported image type. The rest of the property list depends on the
5503 image type. */
5504
5505int
5506valid_image_p (object)
5507 Lisp_Object object;
5508{
5509 int valid_p = 0;
5510
5511 if (CONSP (object) && EQ (XCAR (object), Qimage))
5512 {
1783ffa2
GM		 5513 Lisp_Object tem;
5514
5515 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
5516 if (EQ (XCAR (tem), QCtype))
5517 {
5518 tem = XCDR (tem);
5519 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
5520 {
5521 struct image_type *type;
5522 type = lookup_image_type (XCAR (tem));
5523 if (type)
5524 valid_p = type->valid_p (object);
5525 }
5526
5527 break;
5528 }
333b20bb
GM		 5529 }
5530
5531 return valid_p;
5532}
5533
5534
7ab1745f
GM		 5535/* Log error message with format string FORMAT and argument ARG.
5536 Signaling an error, e.g. when an image cannot be loaded, is not a
5537 good idea because this would interrupt redisplay, and the error
5538 message display would lead to another redisplay. This function
5539 therefore simply displays a message. */
333b20bb
GM		 5540
5541static void
5542image_error (format, arg1, arg2)
5543 char *format;
5544 Lisp_Object arg1, arg2;
5545{
7ab1745f 5546 add_to_log (format, arg1, arg2);
333b20bb
GM		 5547}
5548
5549
5550\f
5551/***********************************************************************
5552 Image specifications
5553 ***********************************************************************/
5554
5555enum image_value_type
5556{
5557 IMAGE_DONT_CHECK_VALUE_TYPE,
5558 IMAGE_STRING_VALUE,
6f1be3b9 5559 IMAGE_STRING_OR_NIL_VALUE,
333b20bb
GM		 5560 IMAGE_SYMBOL_VALUE,
5561 IMAGE_POSITIVE_INTEGER_VALUE,
3ed61e75 5562 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
333b20bb 5563 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
7c7ff7f5 5564 IMAGE_ASCENT_VALUE,
333b20bb
GM		 5565 IMAGE_INTEGER_VALUE,
5566 IMAGE_FUNCTION_VALUE,
5567 IMAGE_NUMBER_VALUE,
5568 IMAGE_BOOL_VALUE
5569};
5570
5571/* Structure used when parsing image specifications. */
5572
5573struct image_keyword
5574{
5575 /* Name of keyword. */
5576 char *name;
5577
5578 /* The type of value allowed. */
5579 enum image_value_type type;
5580
5581 /* Non-zero means key must be present. */
5582 int mandatory_p;
5583
5584 /* Used to recognize duplicate keywords in a property list. */
5585 int count;
5586
5587 /* The value that was found. */
5588 Lisp_Object value;
5589};
5590
5591
bfd2209f
GM		 5592static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
5593 int, Lisp_Object));
333b20bb
GM		 5594static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
5595
5596
5597/* Parse image spec SPEC according to KEYWORDS. A valid image spec
5598 has the format (image KEYWORD VALUE ...). One of the keyword/
5599 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5600 image_keywords structures of size NKEYWORDS describing other
bfd2209f 5601 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
333b20bb
GM		 5602
5603static int
bfd2209f 5604parse_image_spec (spec, keywords, nkeywords, type)
333b20bb
GM		 5605 Lisp_Object spec;
5606 struct image_keyword *keywords;
5607 int nkeywords;
5608 Lisp_Object type;
333b20bb
GM		 5609{
5610 int i;
5611 Lisp_Object plist;
5612
5613 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
5614 return 0;
5615
5616 plist = XCDR (spec);
5617 while (CONSP (plist))
5618 {
5619 Lisp_Object key, value;
5620
5621 /* First element of a pair must be a symbol. */
5622 key = XCAR (plist);
5623 plist = XCDR (plist);
5624 if (!SYMBOLP (key))
5625 return 0;
5626
5627 /* There must follow a value. */
5628 if (!CONSP (plist))
5629 return 0;
5630 value = XCAR (plist);
5631 plist = XCDR (plist);
5632
5633 /* Find key in KEYWORDS. Error if not found. */
5634 for (i = 0; i < nkeywords; ++i)
5635 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
5636 break;
5637
5638 if (i == nkeywords)
bfd2209f 5639 continue;
333b20bb
GM		 5640
5641 /* Record that we recognized the keyword. If a keywords
5642 was found more than once, it's an error. */
5643 keywords[i].value = value;
5644 ++keywords[i].count;
5645
5646 if (keywords[i].count > 1)
5647 return 0;
5648
5649 /* Check type of value against allowed type. */
5650 switch (keywords[i].type)
5651 {
5652 case IMAGE_STRING_VALUE:
5653 if (!STRINGP (value))
5654 return 0;
5655 break;
5656
6f1be3b9
GM		 5657 case IMAGE_STRING_OR_NIL_VALUE:
5658 if (!STRINGP (value) && !NILP (value))
5659 return 0;
5660 break;
5661
333b20bb
GM		 5662 case IMAGE_SYMBOL_VALUE:
5663 if (!SYMBOLP (value))
5664 return 0;
5665 break;
5666
5667 case IMAGE_POSITIVE_INTEGER_VALUE:
5668 if (!INTEGERP (value) || XINT (value) <= 0)
5669 return 0;
5670 break;
5671
3ed61e75
GM		 5672 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
5673 if (INTEGERP (value) && XINT (value) >= 0)
5674 break;
5675 if (CONSP (value)
5676 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
5677 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
5678 break;
5679 return 0;
5680
7c7ff7f5
GM		 5681 case IMAGE_ASCENT_VALUE:
5682 if (SYMBOLP (value) && EQ (value, Qcenter))
5683 break;
5684 else if (INTEGERP (value)
5685 && XINT (value) >= 0
5686 && XINT (value) <= 100)
5687 break;
5688 return 0;
5689
333b20bb
GM		 5690 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
5691 if (!INTEGERP (value) || XINT (value) < 0)
5692 return 0;
5693 break;
5694
5695 case IMAGE_DONT_CHECK_VALUE_TYPE:
5696 break;
5697
5698 case IMAGE_FUNCTION_VALUE:
5699 value = indirect_function (value);
5700 if (SUBRP (value)
5701 || COMPILEDP (value)
5702 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
5703 break;
5704 return 0;
5705
5706 case IMAGE_NUMBER_VALUE:
5707 if (!INTEGERP (value) && !FLOATP (value))
5708 return 0;
5709 break;
5710
5711 case IMAGE_INTEGER_VALUE:
5712 if (!INTEGERP (value))
5713 return 0;
5714 break;
5715
5716 case IMAGE_BOOL_VALUE:
5717 if (!NILP (value) && !EQ (value, Qt))
5718 return 0;
5719 break;
5720
5721 default:
5722 abort ();
5723 break;
5724 }
5725
5726 if (EQ (key, QCtype) && !EQ (type, value))
5727 return 0;
5728 }
5729
5730 /* Check that all mandatory fields are present. */
5731 for (i = 0; i < nkeywords; ++i)
5732 if (keywords[i].mandatory_p && keywords[i].count == 0)
5733 return 0;
5734
5735 return NILP (plist);
5736}
5737
5738
5739/* Return the value of KEY in image specification SPEC. Value is nil
5740 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5741 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5742
5743static Lisp_Object
5744image_spec_value (spec, key, found)
5745 Lisp_Object spec, key;
5746 int *found;
5747{
5748 Lisp_Object tail;
5749
5750 xassert (valid_image_p (spec));
5751
5752 for (tail = XCDR (spec);
5753 CONSP (tail) && CONSP (XCDR (tail));
5754 tail = XCDR (XCDR (tail)))
5755 {
5756 if (EQ (XCAR (tail), key))
5757 {
5758 if (found)
5759 *found = 1;
5760 return XCAR (XCDR (tail));
5761 }
5762 }
5763
5764 if (found)
5765 *found = 0;
5766 return Qnil;
5767}
5768
5769
42677916 5770DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
7ee72033 5771 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
c061c855
GM		 5772PIXELS non-nil means return the size in pixels, otherwise return the
5773size in canonical character units.
5774FRAME is the frame on which the image will be displayed. FRAME nil
7ee72033
MB		 5775or omitted means use the selected frame. */)
5776 (spec, pixels, frame)
42677916
GM		 5777 Lisp_Object spec, pixels, frame;
5778{
5779 Lisp_Object size;
5780
5781 size = Qnil;
5782 if (valid_image_p (spec))
5783 {
5784 struct frame *f = check_x_frame (frame);
83676598 5785 int id = lookup_image (f, spec);
42677916 5786 struct image *img = IMAGE_FROM_ID (f, id);
3ed61e75
GM		 5787 int width = img->width + 2 * img->hmargin;
5788 int height = img->height + 2 * img->vmargin;
42677916
GM		 5789
5790 if (NILP (pixels))
5791 size = Fcons (make_float ((double) width / CANON_X_UNIT (f)),
5792 make_float ((double) height / CANON_Y_UNIT (f)));
5793 else
5794 size = Fcons (make_number (width), make_number (height));
5795 }
5796 else
5797 error ("Invalid image specification");
5798
5799 return size;
5800}
5801
333b20bb 5802
b243755a 5803DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
7ee72033 5804 doc: /* Return t if image SPEC has a mask bitmap.
c061c855 5805FRAME is the frame on which the image will be displayed. FRAME nil
7ee72033
MB		 5806or omitted means use the selected frame. */)
5807 (spec, frame)
b243755a
GM		 5808 Lisp_Object spec, frame;
5809{
5810 Lisp_Object mask;
5811
5812 mask = Qnil;
5813 if (valid_image_p (spec))
5814 {
5815 struct frame *f = check_x_frame (frame);
83676598 5816 int id = lookup_image (f, spec);
b243755a
GM		 5817 struct image *img = IMAGE_FROM_ID (f, id);
5818 if (img->mask)
5819 mask = Qt;
5820 }
5821 else
5822 error ("Invalid image specification");
5823
5824 return mask;
5825}
5826
5827
333b20bb
GM		 5828\f
5829/***********************************************************************
5830 Image type independent image structures
5831 ***********************************************************************/
5832
5833static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
5834static void free_image P_ ((struct frame *f, struct image *img));
5835
5836
5837/* Allocate and return a new image structure for image specification
5838 SPEC. SPEC has a hash value of HASH. */
5839
5840static struct image *
5841make_image (spec, hash)
5842 Lisp_Object spec;
5843 unsigned hash;
5844{
5845 struct image *img = (struct image *) xmalloc (sizeof *img);
5846
5847 xassert (valid_image_p (spec));
5848 bzero (img, sizeof *img);
5849 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
5850 xassert (img->type != NULL);
5851 img->spec = spec;
5852 img->data.lisp_val = Qnil;
5853 img->ascent = DEFAULT_IMAGE_ASCENT;
5854 img->hash = hash;
5855 return img;
5856}
5857
5858
5859/* Free image IMG which was used on frame F, including its resources. */
5860
5861static void
5862free_image (f, img)
5863 struct frame *f;
5864 struct image *img;
5865{
5866 if (img)
5867 {
5868 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5869
5870 /* Remove IMG from the hash table of its cache. */
5871 if (img->prev)
5872 img->prev->next = img->next;
5873 else
5874 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
5875
5876 if (img->next)
5877 img->next->prev = img->prev;
5878
5879 c->images[img->id] = NULL;
5880
5881 /* Free resources, then free IMG. */
5882 img->type->free (f, img);
5883 xfree (img);
5884 }
5885}
5886
5887
5888/* Prepare image IMG for display on frame F. Must be called before
5889 drawing an image. */
5890
5891void
5892prepare_image_for_display (f, img)
5893 struct frame *f;
5894 struct image *img;
5895{
5896 EMACS_TIME t;
5897
5898 /* We're about to display IMG, so set its timestamp to `now'. */
5899 EMACS_GET_TIME (t);
5900 img->timestamp = EMACS_SECS (t);
5901
5902 /* If IMG doesn't have a pixmap yet, load it now, using the image
5903 type dependent loader function. */
dd00328a 5904 if (img->pixmap == None && !img->load_failed_p)
209061be 5905 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb
GM		 5906}
5907
5908
7c7ff7f5
GM		 5909/* Value is the number of pixels for the ascent of image IMG when
5910 drawn in face FACE. */
5911
5912int
5913image_ascent (img, face)
5914 struct image *img;
5915 struct face *face;
5916{
3ed61e75 5917 int height = img->height + img->vmargin;
7c7ff7f5
GM		 5918 int ascent;
5919
5920 if (img->ascent == CENTERED_IMAGE_ASCENT)
5921 {
5922 if (face->font)
3694cb3f
MB		 5923 /* This expression is arranged so that if the image can't be
5924 exactly centered, it will be moved slightly up. This is
5925 because a typical font is `top-heavy' (due to the presence
5926 uppercase letters), so the image placement should err towards
5927 being top-heavy too. It also just generally looks better. */
5928 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
7c7ff7f5
GM		 5929 else
5930 ascent = height / 2;
5931 }
5932 else
5933 ascent = height * img->ascent / 100.0;
5934
5935 return ascent;
5936}
5937
f20a3b7a
MB		 5938\f
5939/* Image background colors. */
5940
5941static unsigned long
5942four_corners_best (ximg, width, height)
5943 XImage *ximg;
5944 unsigned long width, height;
5945{
b350c2e5
GM		 5946 unsigned long corners[4], best;
5947 int i, best_count;
f20a3b7a 5948
b350c2e5
GM		 5949 /* Get the colors at the corners of ximg. */
5950 corners[0] = XGetPixel (ximg, 0, 0);
5951 corners[1] = XGetPixel (ximg, width - 1, 0);
5952 corners[2] = XGetPixel (ximg, width - 1, height - 1);
5953 corners[3] = XGetPixel (ximg, 0, height - 1);
f20a3b7a 5954
b350c2e5
GM		 5955 /* Choose the most frequently found color as background. */
5956 for (i = best_count = 0; i < 4; ++i)
5957 {
5958 int j, n;
f20a3b7a 5959
b350c2e5
GM		 5960 for (j = n = 0; j < 4; ++j)
5961 if (corners[i] == corners[j])
5962 ++n;
f20a3b7a 5963
b350c2e5
GM		 5964 if (n > best_count)
5965 best = corners[i], best_count = n;
5966 }
f20a3b7a 5967
b350c2e5 5968 return best;
f20a3b7a
MB		 5969}
5970
5971/* Return the `background' field of IMG. If IMG doesn't have one yet,
5972 it is guessed heuristically. If non-zero, XIMG is an existing XImage
5973 object to use for the heuristic. */
5974
5975unsigned long
5976image_background (img, f, ximg)
5977 struct image *img;
5978 struct frame *f;
5979 XImage *ximg;
5980{
5981 if (! img->background_valid)
5982 /* IMG doesn't have a background yet, try to guess a reasonable value. */
5983 {
5984 int free_ximg = !ximg;
5985
5986 if (! ximg)
5987 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
5988 0, 0, img->width, img->height, ~0, ZPixmap);
5989
5990 img->background = four_corners_best (ximg, img->width, img->height);
5991
5992 if (free_ximg)
5993 XDestroyImage (ximg);
5994
5995 img->background_valid = 1;
5996 }
5997
5998 return img->background;
5999}
6000
6001/* Return the `background_transparent' field of IMG. If IMG doesn't
6002 have one yet, it is guessed heuristically. If non-zero, MASK is an
6003 existing XImage object to use for the heuristic. */
6004
6005int
6006image_background_transparent (img, f, mask)
6007 struct image *img;
6008 struct frame *f;
6009 XImage *mask;
6010{
6011 if (! img->background_transparent_valid)
6012 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6013 {
6014 if (img->mask)
6015 {
6016 int free_mask = !mask;
6017
6018 if (! mask)
6019 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
6020 0, 0, img->width, img->height, ~0, ZPixmap);
6021
6022 img->background_transparent
6023 = !four_corners_best (mask, img->width, img->height);
6024
6025 if (free_mask)
6026 XDestroyImage (mask);
6027 }
6028 else
6029 img->background_transparent = 0;
6030
6031 img->background_transparent_valid = 1;
6032 }
6033
6034 return img->background_transparent;
6035}
7c7ff7f5 6036
333b20bb
GM		 6037\f
6038/***********************************************************************
6039 Helper functions for X image types
6040 ***********************************************************************/
6041
dd00328a
GM		 6042static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
6043 int, int));
333b20bb
GM		 6044static void x_clear_image P_ ((struct frame *f, struct image *img));
6045static unsigned long x_alloc_image_color P_ ((struct frame *f,
6046 struct image *img,
6047 Lisp_Object color_name,
6048 unsigned long dflt));
6049
dd00328a
GM		 6050
6051/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6052 free the pixmap if any. MASK_P non-zero means clear the mask
6053 pixmap if any. COLORS_P non-zero means free colors allocated for
6054 the image, if any. */
333b20bb
GM		 6055
6056static void
dd00328a 6057x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
333b20bb
GM		 6058 struct frame *f;
6059 struct image *img;
dd00328a 6060 int pixmap_p, mask_p, colors_p;
333b20bb 6061{
dd00328a 6062 if (pixmap_p && img->pixmap)
333b20bb 6063 {
333b20bb 6064 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 6065 img->pixmap = None;
f20a3b7a 6066 img->background_valid = 0;
f4779de9
GM		 6067 }
6068
dd00328a 6069 if (mask_p && img->mask)
f4779de9
GM		 6070 {
6071 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 6072 img->mask = None;
f20a3b7a 6073 img->background_transparent_valid = 0;
333b20bb
GM		 6074 }
6075
dd00328a 6076 if (colors_p && img->ncolors)
333b20bb 6077 {
462d5d40 6078 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM		 6079 xfree (img->colors);
6080 img->colors = NULL;
6081 img->ncolors = 0;
6082 }
dd00328a
GM		 6083}
6084
6085/* Free X resources of image IMG which is used on frame F. */
6086
6087static void
6088x_clear_image (f, img)
6089 struct frame *f;
6090 struct image *img;
6091{
6092 BLOCK_INPUT;
6093 x_clear_image_1 (f, img, 1, 1, 1);
f4779de9 6094 UNBLOCK_INPUT;
333b20bb
GM		 6095}
6096
6097
6098/* Allocate color COLOR_NAME for image IMG on frame F. If color
6099 cannot be allocated, use DFLT. Add a newly allocated color to
6100 IMG->colors, so that it can be freed again. Value is the pixel
6101 color. */
6102
6103static unsigned long
6104x_alloc_image_color (f, img, color_name, dflt)
6105 struct frame *f;
6106 struct image *img;
6107 Lisp_Object color_name;
6108 unsigned long dflt;
6109{
6110 XColor color;
6111 unsigned long result;
6112
6113 xassert (STRINGP (color_name));
6114
2d764c78 6115 if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
333b20bb
GM		 6116 {
6117 /* This isn't called frequently so we get away with simply
6118 reallocating the color vector to the needed size, here. */
6119 ++img->ncolors;
6120 img->colors =
6121 (unsigned long *) xrealloc (img->colors,
6122 img->ncolors * sizeof *img->colors);
6123 img->colors[img->ncolors - 1] = color.pixel;
6124 result = color.pixel;
6125 }
6126 else
6127 result = dflt;
6128
6129 return result;
6130}
6131
6132
6133\f
6134/***********************************************************************
6135 Image Cache
6136 ***********************************************************************/
6137
6138static void cache_image P_ ((struct frame *f, struct image *img));
ad18ffb1 6139static void postprocess_image P_ ((struct frame *, struct image *));
333b20bb
GM		 6140
6141
6142/* Return a new, initialized image cache that is allocated from the
6143 heap. Call free_image_cache to free an image cache. */
6144
6145struct image_cache *
6146make_image_cache ()
6147{
6148 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
6149 int size;
6150
6151 bzero (c, sizeof *c);
6152 c->size = 50;
6153 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
6154 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
6155 c->buckets = (struct image **) xmalloc (size);
6156 bzero (c->buckets, size);
6157 return c;
6158}
6159
6160
6161/* Free image cache of frame F. Be aware that X frames share images
6162 caches. */
6163
6164void
6165free_image_cache (f)
6166 struct frame *f;
6167{
6168 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6169 if (c)
6170 {
6171 int i;
6172
6173 /* Cache should not be referenced by any frame when freed. */
6174 xassert (c->refcount == 0);
6175
6176 for (i = 0; i < c->used; ++i)
6177 free_image (f, c->images[i]);
6178 xfree (c->images);
333b20bb 6179 xfree (c->buckets);
e3130015 6180 xfree (c);
333b20bb
GM		 6181 FRAME_X_IMAGE_CACHE (f) = NULL;
6182 }
6183}
6184
6185
6186/* Clear image cache of frame F. FORCE_P non-zero means free all
6187 images. FORCE_P zero means clear only images that haven't been
6188 displayed for some time. Should be called from time to time to
6189 reduce the number of loaded images. If image-eviction-seconds is
6190 non-nil, this frees images in the cache which weren't displayed for
6191 at least that many seconds. */
6192
6193void
6194clear_image_cache (f, force_p)
6195 struct frame *f;
6196 int force_p;
6197{
6198 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6199
83676598 6200 if (c && INTEGERP (Vimage_cache_eviction_delay))
333b20bb
GM		 6201 {
6202 EMACS_TIME t;
6203 unsigned long old;
f4779de9 6204 int i, nfreed;
333b20bb
GM		 6205
6206 EMACS_GET_TIME (t);
fcf431dc 6207 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
f4779de9
GM		 6208
6209 /* Block input so that we won't be interrupted by a SIGIO
6210 while being in an inconsistent state. */
6211 BLOCK_INPUT;
333b20bb 6212
f4779de9 6213 for (i = nfreed = 0; i < c->used; ++i)
333b20bb
GM		 6214 {
6215 struct image *img = c->images[i];
6216 if (img != NULL
f4779de9 6217 && (force_p || img->timestamp < old))
333b20bb
GM		 6218 {
6219 free_image (f, img);
f4779de9 6220 ++nfreed;
333b20bb
GM		 6221 }
6222 }
6223
6224 /* We may be clearing the image cache because, for example,
6225 Emacs was iconified for a longer period of time. In that
6226 case, current matrices may still contain references to
6227 images freed above. So, clear these matrices. */
f4779de9 6228 if (nfreed)
333b20bb 6229 {
f4779de9
GM		 6230 Lisp_Object tail, frame;
6231
6232 FOR_EACH_FRAME (tail, frame)
6233 {
6234 struct frame *f = XFRAME (frame);
6235 if (FRAME_X_P (f)
6236 && FRAME_X_IMAGE_CACHE (f) == c)
83676598 6237 clear_current_matrices (f);
f4779de9
GM		 6238 }
6239
333b20bb
GM		 6240 ++windows_or_buffers_changed;
6241 }
f4779de9
GM		 6242
6243 UNBLOCK_INPUT;
333b20bb
GM		 6244 }
6245}
6246
6247
6248DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
6249 0, 1, 0,
7ee72033 6250 doc: /* Clear the image cache of FRAME.
c061c855 6251FRAME nil or omitted means use the selected frame.
7ee72033
MB		 6252FRAME t means clear the image caches of all frames. */)
6253 (frame)
333b20bb
GM		 6254 Lisp_Object frame;
6255{
6256 if (EQ (frame, Qt))
6257 {
6258 Lisp_Object tail;
6259
6260 FOR_EACH_FRAME (tail, frame)
6261 if (FRAME_X_P (XFRAME (frame)))
6262 clear_image_cache (XFRAME (frame), 1);
6263 }
6264 else
6265 clear_image_cache (check_x_frame (frame), 1);
6266
6267 return Qnil;
6268}
6269
6270
ad18ffb1
GM		 6271/* Compute masks and transform image IMG on frame F, as specified
6272 by the image's specification, */
6273
6274static void
6275postprocess_image (f, img)
6276 struct frame *f;
6277 struct image *img;
6278{
6279 /* Manipulation of the image's mask. */
6280 if (img->pixmap)
6281 {
6282 Lisp_Object conversion, spec;
6283 Lisp_Object mask;
6284
6285 spec = img->spec;
6286
6287 /* `:heuristic-mask t'
6288 `:mask heuristic'
6289 means build a mask heuristically.
6290 `:heuristic-mask (R G B)'
6291 `:mask (heuristic (R G B))'
6292 means build a mask from color (R G B) in the
6293 image.
6294 `:mask nil'
6295 means remove a mask, if any. */
6296
6297 mask = image_spec_value (spec, QCheuristic_mask, NULL);
6298 if (!NILP (mask))
6299 x_build_heuristic_mask (f, img, mask);
6300 else
6301 {
6302 int found_p;
6303
6304 mask = image_spec_value (spec, QCmask, &found_p);
6305
6306 if (EQ (mask, Qheuristic))
6307 x_build_heuristic_mask (f, img, Qt);
6308 else if (CONSP (mask)
6309 && EQ (XCAR (mask), Qheuristic))
6310 {
6311 if (CONSP (XCDR (mask)))
6312 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
6313 else
6314 x_build_heuristic_mask (f, img, XCDR (mask));
6315 }
6316 else if (NILP (mask) && found_p && img->mask)
6317 {
6318 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
6319 img->mask = None;
6320 }
6321 }
6322
6323
6324 /* Should we apply an image transformation algorithm? */
6325 conversion = image_spec_value (spec, QCconversion, NULL);
6326 if (EQ (conversion, Qdisabled))
6327 x_disable_image (f, img);
6328 else if (EQ (conversion, Qlaplace))
6329 x_laplace (f, img);
6330 else if (EQ (conversion, Qemboss))
6331 x_emboss (f, img);
6332 else if (CONSP (conversion)
6333 && EQ (XCAR (conversion), Qedge_detection))
6334 {
6335 Lisp_Object tem;
6336 tem = XCDR (conversion);
6337 if (CONSP (tem))
6338 x_edge_detection (f, img,
6339 Fplist_get (tem, QCmatrix),
6340 Fplist_get (tem, QCcolor_adjustment));
6341 }
6342 }
6343}
6344
6345
333b20bb 6346/* Return the id of image with Lisp specification SPEC on frame F.
83676598 6347 SPEC must be a valid Lisp image specification (see valid_image_p). */
333b20bb
GM		 6348
6349int
83676598 6350lookup_image (f, spec)
333b20bb
GM		 6351 struct frame *f;
6352 Lisp_Object spec;
6353{
6354 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6355 struct image *img;
6356 int i;
6357 unsigned hash;
6358 struct gcpro gcpro1;
4f7ca1f1 6359 EMACS_TIME now;
333b20bb
GM		 6360
6361 /* F must be a window-system frame, and SPEC must be a valid image
6362 specification. */
6363 xassert (FRAME_WINDOW_P (f));
6364 xassert (valid_image_p (spec));
6365
6366 GCPRO1 (spec);
6367
6368 /* Look up SPEC in the hash table of the image cache. */
6369 hash = sxhash (spec, 0);
6370 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
6371
6372 for (img = c->buckets[i]; img; img = img->next)
6373 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
6374 break;
6375
6376 /* If not found, create a new image and cache it. */
6377 if (img == NULL)
6378 {
ad18ffb1
GM		 6379 extern Lisp_Object Qpostscript;
6380
28c7826c 6381 BLOCK_INPUT;
333b20bb
GM		 6382 img = make_image (spec, hash);
6383 cache_image (f, img);
83676598 6384 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb
GM		 6385
6386 /* If we can't load the image, and we don't have a width and
6387 height, use some arbitrary width and height so that we can
6388 draw a rectangle for it. */
83676598 6389 if (img->load_failed_p)
333b20bb
GM		 6390 {
6391 Lisp_Object value;
6392
6393 value = image_spec_value (spec, QCwidth, NULL);
6394 img->width = (INTEGERP (value)
6395 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
6396 value = image_spec_value (spec, QCheight, NULL);
6397 img->height = (INTEGERP (value)
6398 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
6399 }
6400 else
6401 {
6402 /* Handle image type independent image attributes
f20a3b7a
MB		 6403 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6404 `:background COLOR'. */
6405 Lisp_Object ascent, margin, relief, bg;
333b20bb
GM		 6406
6407 ascent = image_spec_value (spec, QCascent, NULL);
6408 if (INTEGERP (ascent))
6409 img->ascent = XFASTINT (ascent);
7c7ff7f5
GM		 6410 else if (EQ (ascent, Qcenter))
6411 img->ascent = CENTERED_IMAGE_ASCENT;
333b20bb
GM		 6412
6413 margin = image_spec_value (spec, QCmargin, NULL);
6414 if (INTEGERP (margin) && XINT (margin) >= 0)
3ed61e75
GM		 6415 img->vmargin = img->hmargin = XFASTINT (margin);
6416 else if (CONSP (margin) && INTEGERP (XCAR (margin))
6417 && INTEGERP (XCDR (margin)))
6418 {
6419 if (XINT (XCAR (margin)) > 0)
6420 img->hmargin = XFASTINT (XCAR (margin));
6421 if (XINT (XCDR (margin)) > 0)
6422 img->vmargin = XFASTINT (XCDR (margin));
6423 }
333b20bb
GM		 6424
6425 relief = image_spec_value (spec, QCrelief, NULL);
6426 if (INTEGERP (relief))
6427 {
6428 img->relief = XINT (relief);
3ed61e75
GM		 6429 img->hmargin += abs (img->relief);
6430 img->vmargin += abs (img->relief);
333b20bb
GM		 6431 }
6432
f20a3b7a
MB		 6433 if (! img->background_valid)
6434 {
6435 bg = image_spec_value (img->spec, QCbackground, NULL);
6436 if (!NILP (bg))
6437 {
6438 img->background
6439 = x_alloc_image_color (f, img, bg,
6440 FRAME_BACKGROUND_PIXEL (f));
6441 img->background_valid = 1;
6442 }
6443 }
6444
ad18ffb1
GM		 6445 /* Do image transformations and compute masks, unless we
6446 don't have the image yet. */
6447 if (!EQ (*img->type->type, Qpostscript))
6448 postprocess_image (f, img);
333b20bb 6449 }
dd00328a 6450
28c7826c
GM		 6451 UNBLOCK_INPUT;
6452 xassert (!interrupt_input_blocked);
333b20bb
GM		 6453 }
6454
4f7ca1f1
GM		 6455 /* We're using IMG, so set its timestamp to `now'. */
6456 EMACS_GET_TIME (now);
6457 img->timestamp = EMACS_SECS (now);
6458
333b20bb
GM		 6459 UNGCPRO;
6460
6461 /* Value is the image id. */
6462 return img->id;
6463}
6464
6465
6466/* Cache image IMG in the image cache of frame F. */
6467
6468static void
6469cache_image (f, img)
6470 struct frame *f;
6471 struct image *img;
6472{
6473 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6474 int i;
6475
6476 /* Find a free slot in c->images. */
6477 for (i = 0; i < c->used; ++i)
6478 if (c->images[i] == NULL)
6479 break;
6480
6481 /* If no free slot found, maybe enlarge c->images. */
6482 if (i == c->used && c->used == c->size)
6483 {
6484 c->size *= 2;
6485 c->images = (struct image **) xrealloc (c->images,
6486 c->size * sizeof *c->images);
6487 }
6488
6489 /* Add IMG to c->images, and assign IMG an id. */
6490 c->images[i] = img;
6491 img->id = i;
6492 if (i == c->used)
6493 ++c->used;
6494
6495 /* Add IMG to the cache's hash table. */
6496 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
6497 img->next = c->buckets[i];
6498 if (img->next)
6499 img->next->prev = img;
6500 img->prev = NULL;
6501 c->buckets[i] = img;
6502}
6503
6504
6505/* Call FN on every image in the image cache of frame F. Used to mark
6506 Lisp Objects in the image cache. */
6507
6508void
6509forall_images_in_image_cache (f, fn)
6510 struct frame *f;
6511 void (*fn) P_ ((struct image *img));
6512{
6513 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
6514 {
6515 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6516 if (c)
6517 {
6518 int i;
6519 for (i = 0; i < c->used; ++i)
6520 if (c->images[i])
6521 fn (c->images[i]);
6522 }
6523 }
6524}
6525
6526
6527\f
6528/***********************************************************************
6529 X support code
6530 ***********************************************************************/
6531
45158a91
GM		 6532static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
6533 XImage **, Pixmap *));
333b20bb
GM		 6534static void x_destroy_x_image P_ ((XImage *));
6535static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
6536
6537
6538/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6539 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6540 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6541 via xmalloc. Print error messages via image_error if an error
45158a91 6542 occurs. Value is non-zero if successful. */
333b20bb
GM		 6543
6544static int
45158a91 6545x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
333b20bb 6546 struct frame *f;
333b20bb
GM		 6547 int width, height, depth;
6548 XImage **ximg;
6549 Pixmap *pixmap;
6550{
6551 Display *display = FRAME_X_DISPLAY (f);
6552 Screen *screen = FRAME_X_SCREEN (f);
6553 Window window = FRAME_X_WINDOW (f);
6554
6555 xassert (interrupt_input_blocked);
6556
6557 if (depth <= 0)
6558 depth = DefaultDepthOfScreen (screen);
6559 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
6560 depth, ZPixmap, 0, NULL, width, height,
6561 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
6562 if (*ximg == NULL)
6563 {
45158a91 6564 image_error ("Unable to allocate X image", Qnil, Qnil);
333b20bb
GM		 6565 return 0;
6566 }
6567
6568 /* Allocate image raster. */
6569 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
6570
6571 /* Allocate a pixmap of the same size. */
6572 *pixmap = XCreatePixmap (display, window, width, height, depth);
dd00328a 6573 if (*pixmap == None)
333b20bb
GM		 6574 {
6575 x_destroy_x_image (*ximg);
6576 *ximg = NULL;
45158a91 6577 image_error ("Unable to create X pixmap", Qnil, Qnil);
333b20bb
GM		 6578 return 0;
6579 }
6580
6581 return 1;
6582}
6583
6584
6585/* Destroy XImage XIMG. Free XIMG->data. */
6586
6587static void
6588x_destroy_x_image (ximg)
6589 XImage *ximg;
6590{
6591 xassert (interrupt_input_blocked);
6592 if (ximg)
6593 {
6594 xfree (ximg->data);
6595 ximg->data = NULL;
6596 XDestroyImage (ximg);
6597 }
6598}
6599
6600
6601/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6602 are width and height of both the image and pixmap. */
6603
ea6b19ca 6604static void
333b20bb
GM		 6605x_put_x_image (f, ximg, pixmap, width, height)
6606 struct frame *f;
6607 XImage *ximg;
6608 Pixmap pixmap;
6609{
6610 GC gc;
6611
6612 xassert (interrupt_input_blocked);
6613 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
6614 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
6615 XFreeGC (FRAME_X_DISPLAY (f), gc);
6616}
6617
6618
6619\f
6620/***********************************************************************
5be6c3b0 6621 File Handling
333b20bb
GM		 6622 ***********************************************************************/
6623
6624static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5be6c3b0
GM		 6625static char *slurp_file P_ ((char *, int *));
6626
333b20bb
GM		 6627
6628/* Find image file FILE. Look in data-directory, then
6629 x-bitmap-file-path. Value is the full name of the file found, or
6630 nil if not found. */
6631
6632static Lisp_Object
6633x_find_image_file (file)
6634 Lisp_Object file;
6635{
6636 Lisp_Object file_found, search_path;
6637 struct gcpro gcpro1, gcpro2;
6638 int fd;
6639
6640 file_found = Qnil;
6641 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
6642 GCPRO2 (file_found, search_path);
6643
6644 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
c0ec53ad 6645 fd = openp (search_path, file, Qnil, &file_found, 0);
333b20bb 6646
939d6465 6647 if (fd == -1)
333b20bb
GM		 6648 file_found = Qnil;
6649 else
6650 close (fd);
6651
6652 UNGCPRO;
6653 return file_found;
6654}
6655
6656
5be6c3b0
GM		 6657/* Read FILE into memory. Value is a pointer to a buffer allocated
6658 with xmalloc holding FILE's contents. Value is null if an error
b243755a 6659 occurred. *SIZE is set to the size of the file. */
5be6c3b0
GM		 6660
6661static char *
6662slurp_file (file, size)
6663 char *file;
6664 int *size;
6665{
6666 FILE *fp = NULL;
6667 char *buf = NULL;
6668 struct stat st;
6669
6670 if (stat (file, &st) == 0
6671 && (fp = fopen (file, "r")) != NULL
6672 && (buf = (char *) xmalloc (st.st_size),
6673 fread (buf, 1, st.st_size, fp) == st.st_size))
6674 {
6675 *size = st.st_size;
6676 fclose (fp);
6677 }
6678 else
6679 {
6680 if (fp)
6681 fclose (fp);
6682 if (buf)
6683 {
6684 xfree (buf);
6685 buf = NULL;
6686 }
6687 }
6688
6689 return buf;
6690}
6691
6692
333b20bb
GM		 6693\f
6694/***********************************************************************
6695 XBM images
6696 ***********************************************************************/
6697
5be6c3b0 6698static int xbm_scan P_ ((char **, char *, char *, int *));
333b20bb 6699static int xbm_load P_ ((struct frame *f, struct image *img));
5be6c3b0
GM		 6700static int xbm_load_image P_ ((struct frame *f, struct image *img,
6701 char *, char *));
333b20bb 6702static int xbm_image_p P_ ((Lisp_Object object));
5be6c3b0
GM		 6703static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
6704 unsigned char **));
6705static int xbm_file_p P_ ((Lisp_Object));
333b20bb
GM		 6706
6707
6708/* Indices of image specification fields in xbm_format, below. */
6709
6710enum xbm_keyword_index
6711{
6712 XBM_TYPE,
6713 XBM_FILE,
6714 XBM_WIDTH,
6715 XBM_HEIGHT,
6716 XBM_DATA,
6717 XBM_FOREGROUND,
6718 XBM_BACKGROUND,
6719 XBM_ASCENT,
6720 XBM_MARGIN,
6721 XBM_RELIEF,
6722 XBM_ALGORITHM,
6723 XBM_HEURISTIC_MASK,
4a8e312c 6724 XBM_MASK,
333b20bb
GM		 6725 XBM_LAST
6726};
6727
6728/* Vector of image_keyword structures describing the format
6729 of valid XBM image specifications. */
6730
6731static struct image_keyword xbm_format[XBM_LAST] =
6732{
6733 {":type", IMAGE_SYMBOL_VALUE, 1},
6734 {":file", IMAGE_STRING_VALUE, 0},
6735 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6736 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6737 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM		 6738 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
6739 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
7c7ff7f5 6740 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 6741 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 6742 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 6743 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 6744 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6745 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 6746};
6747
6748/* Structure describing the image type XBM. */
6749
6750static struct image_type xbm_type =
6751{
6752 &Qxbm,
6753 xbm_image_p,
6754 xbm_load,
6755 x_clear_image,
6756 NULL
6757};
6758
6759/* Tokens returned from xbm_scan. */
6760
6761enum xbm_token
6762{
6763 XBM_TK_IDENT = 256,
6764 XBM_TK_NUMBER
6765};
6766
6767
6768/* Return non-zero if OBJECT is a valid XBM-type image specification.
6769 A valid specification is a list starting with the symbol `image'
6770 The rest of the list is a property list which must contain an
6771 entry `:type xbm..
6772
6773 If the specification specifies a file to load, it must contain
6774 an entry `:file FILENAME' where FILENAME is a string.
6775
6776 If the specification is for a bitmap loaded from memory it must
6777 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6778 WIDTH and HEIGHT are integers > 0. DATA may be:
6779
6780 1. a string large enough to hold the bitmap data, i.e. it must
6781 have a size >= (WIDTH + 7) / 8 * HEIGHT
6782
6783 2. a bool-vector of size >= WIDTH * HEIGHT
6784
6785 3. a vector of strings or bool-vectors, one for each line of the
6786 bitmap.
6787
5be6c3b0
GM		 6788 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6789 may not be specified in this case because they are defined in the
6790 XBM file.
6791
333b20bb
GM		 6792 Both the file and data forms may contain the additional entries
6793 `:background COLOR' and `:foreground COLOR'. If not present,
6794 foreground and background of the frame on which the image is
e3130015 6795 displayed is used. */
333b20bb
GM		 6796
6797static int
6798xbm_image_p (object)
6799 Lisp_Object object;
6800{
6801 struct image_keyword kw[XBM_LAST];
6802
6803 bcopy (xbm_format, kw, sizeof kw);
bfd2209f 6804 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
333b20bb
GM		 6805 return 0;
6806
6807 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
6808
6809 if (kw[XBM_FILE].count)
6810 {
6811 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
6812 return 0;
6813 }
5be6c3b0
GM		 6814 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
6815 {
6816 /* In-memory XBM file. */
6817 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
6818 return 0;
6819 }
333b20bb
GM		 6820 else
6821 {
6822 Lisp_Object data;
6823 int width, height;
6824
6825 /* Entries for `:width', `:height' and `:data' must be present. */
6826 if (!kw[XBM_WIDTH].count
6827 || !kw[XBM_HEIGHT].count
6828 || !kw[XBM_DATA].count)
6829 return 0;
6830
6831 data = kw[XBM_DATA].value;
6832 width = XFASTINT (kw[XBM_WIDTH].value);
6833 height = XFASTINT (kw[XBM_HEIGHT].value);
6834
6835 /* Check type of data, and width and height against contents of
6836 data. */
6837 if (VECTORP (data))
6838 {
6839 int i;
6840
6841 /* Number of elements of the vector must be >= height. */
6842 if (XVECTOR (data)->size < height)
6843 return 0;
6844
6845 /* Each string or bool-vector in data must be large enough
6846 for one line of the image. */
6847 for (i = 0; i < height; ++i)
6848 {
6849 Lisp_Object elt = XVECTOR (data)->contents[i];
6850
6851 if (STRINGP (elt))
6852 {
6853 if (XSTRING (elt)->size
6854 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6855 return 0;
6856 }
6857 else if (BOOL_VECTOR_P (elt))
6858 {
6859 if (XBOOL_VECTOR (elt)->size < width)
6860 return 0;
6861 }
6862 else
6863 return 0;
6864 }
6865 }
6866 else if (STRINGP (data))
6867 {
6868 if (XSTRING (data)->size
6869 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
6870 return 0;
6871 }
6872 else if (BOOL_VECTOR_P (data))
6873 {
6874 if (XBOOL_VECTOR (data)->size < width * height)
6875 return 0;
6876 }
6877 else
6878 return 0;
6879 }
6880
333b20bb
GM		 6881 return 1;
6882}
6883
6884
6885/* Scan a bitmap file. FP is the stream to read from. Value is
6886 either an enumerator from enum xbm_token, or a character for a
6887 single-character token, or 0 at end of file. If scanning an
6888 identifier, store the lexeme of the identifier in SVAL. If
6889 scanning a number, store its value in *IVAL. */
6890
6891static int
5be6c3b0
GM		 6892xbm_scan (s, end, sval, ival)
6893 char **s, *end;
333b20bb
GM		 6894 char *sval;
6895 int *ival;
6896{
6897 int c;
0a695da7
GM		 6898
6899 loop:
333b20bb
GM		 6900
6901 /* Skip white space. */
5be6c3b0 6902 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM		 6903 ;
6904
5be6c3b0 6905 if (*s >= end)
333b20bb
GM		 6906 c = 0;
6907 else if (isdigit (c))
6908 {
6909 int value = 0, digit;
6910
5be6c3b0 6911 if (c == '0' && *s < end)
333b20bb 6912 {
5be6c3b0 6913 c = *(*s)++;
333b20bb
GM		 6914 if (c == 'x' || c == 'X')
6915 {
5be6c3b0 6916 while (*s < end)
333b20bb 6917 {
5be6c3b0 6918 c = *(*s)++;
333b20bb
GM		 6919 if (isdigit (c))
6920 digit = c - '0';
6921 else if (c >= 'a' && c <= 'f')
6922 digit = c - 'a' + 10;
6923 else if (c >= 'A' && c <= 'F')
6924 digit = c - 'A' + 10;
6925 else
6926 break;
6927 value = 16 * value + digit;
6928 }
6929 }
6930 else if (isdigit (c))
6931 {
6932 value = c - '0';
5be6c3b0
GM		 6933 while (*s < end
6934 && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 6935 value = 8 * value + c - '0';
6936 }
6937 }
6938 else
6939 {
6940 value = c - '0';
5be6c3b0
GM		 6941 while (*s < end
6942 && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 6943 value = 10 * value + c - '0';
6944 }
6945
5be6c3b0
GM		 6946 if (*s < end)
6947 *s = *s - 1;
333b20bb
GM		 6948 *ival = value;
6949 c = XBM_TK_NUMBER;
6950 }
6951 else if (isalpha (c) || c == '_')
6952 {
6953 *sval++ = c;
5be6c3b0
GM		 6954 while (*s < end
6955 && (c = *(*s)++, (isalnum (c) || c == '_')))
333b20bb
GM		 6956 *sval++ = c;
6957 *sval = 0;
5be6c3b0
GM		 6958 if (*s < end)
6959 *s = *s - 1;
333b20bb
GM		 6960 c = XBM_TK_IDENT;
6961 }
0a695da7
GM		 6962 else if (c == '/' && **s == '*')
6963 {
6964 /* C-style comment. */
6965 ++*s;
6966 while (**s && (**s != '*' || *(*s + 1) != '/'))
6967 ++*s;
6968 if (**s)
6969 {
6970 *s += 2;
6971 goto loop;
6972 }
6973 }
333b20bb
GM		 6974
6975 return c;
6976}
6977
6978
6979/* Replacement for XReadBitmapFileData which isn't available under old
5be6c3b0
GM		 6980 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6981 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6982 the image. Return in *DATA the bitmap data allocated with xmalloc.
6983 Value is non-zero if successful. DATA null means just test if
b243755a 6984 CONTENTS looks like an in-memory XBM file. */
333b20bb
GM		 6985
6986static int
5be6c3b0
GM		 6987xbm_read_bitmap_data (contents, end, width, height, data)
6988 char *contents, *end;
333b20bb
GM		 6989 int *width, *height;
6990 unsigned char **data;
6991{
5be6c3b0 6992 char *s = contents;
333b20bb
GM		 6993 char buffer[BUFSIZ];
6994 int padding_p = 0;
6995 int v10 = 0;
6996 int bytes_per_line, i, nbytes;
6997 unsigned char *p;
6998 int value;
6999 int LA1;
7000
7001#define match() \
5be6c3b0 7002 LA1 = xbm_scan (&s, end, buffer, &value)
333b20bb
GM		 7003
7004#define expect(TOKEN) \
7005 if (LA1 != (TOKEN)) \
7006 goto failure; \
7007 else \
7008 match ()
7009
7010#define expect_ident(IDENT) \
7011 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7012 match (); \
7013 else \
7014 goto failure
7015
333b20bb 7016 *width = *height = -1;
5be6c3b0
GM		 7017 if (data)
7018 *data = NULL;
7019 LA1 = xbm_scan (&s, end, buffer, &value);
333b20bb
GM		 7020
7021 /* Parse defines for width, height and hot-spots. */
7022 while (LA1 == '#')
7023 {
333b20bb
GM		 7024 match ();
7025 expect_ident ("define");
7026 expect (XBM_TK_IDENT);
7027
7028 if (LA1 == XBM_TK_NUMBER);
7029 {
7030 char *p = strrchr (buffer, '_');
7031 p = p ? p + 1 : buffer;
7032 if (strcmp (p, "width") == 0)
7033 *width = value;
7034 else if (strcmp (p, "height") == 0)
7035 *height = value;
7036 }
7037 expect (XBM_TK_NUMBER);
7038 }
7039
7040 if (*width < 0 || *height < 0)
7041 goto failure;
5be6c3b0
GM		 7042 else if (data == NULL)
7043 goto success;
333b20bb
GM		 7044
7045 /* Parse bits. Must start with `static'. */
7046 expect_ident ("static");
7047 if (LA1 == XBM_TK_IDENT)
7048 {
7049 if (strcmp (buffer, "unsigned") == 0)
7050 {
7051 match ();
7052 expect_ident ("char");
7053 }
7054 else if (strcmp (buffer, "short") == 0)
7055 {
7056 match ();
7057 v10 = 1;
7058 if (*width % 16 && *width % 16 < 9)
7059 padding_p = 1;
7060 }
7061 else if (strcmp (buffer, "char") == 0)
7062 match ();
7063 else
7064 goto failure;
7065 }
7066 else
7067 goto failure;
7068
7069 expect (XBM_TK_IDENT);
7070 expect ('[');
7071 expect (']');
7072 expect ('=');
7073 expect ('{');
7074
7075 bytes_per_line = (*width + 7) / 8 + padding_p;
7076 nbytes = bytes_per_line * *height;
7077 p = *data = (char *) xmalloc (nbytes);
7078
7079 if (v10)
7080 {
333b20bb
GM		 7081 for (i = 0; i < nbytes; i += 2)
7082 {
7083 int val = value;
7084 expect (XBM_TK_NUMBER);
7085
7086 *p++ = val;
7087 if (!padding_p || ((i + 2) % bytes_per_line))
7088 *p++ = value >> 8;
7089
7090 if (LA1 == ',' || LA1 == '}')
7091 match ();
7092 else
7093 goto failure;
7094 }
7095 }
7096 else
7097 {
7098 for (i = 0; i < nbytes; ++i)
7099 {
7100 int val = value;
7101 expect (XBM_TK_NUMBER);
7102
7103 *p++ = val;
7104
7105 if (LA1 == ',' || LA1 == '}')
7106 match ();
7107 else
7108 goto failure;
7109 }
7110 }
7111
5be6c3b0 7112 success:
333b20bb
GM		 7113 return 1;
7114
7115 failure:
7116
5be6c3b0 7117 if (data && *data)
333b20bb
GM		 7118 {
7119 xfree (*data);
7120 *data = NULL;
7121 }
7122 return 0;
7123
7124#undef match
7125#undef expect
7126#undef expect_ident
7127}
7128
7129
5be6c3b0
GM		 7130/* Load XBM image IMG which will be displayed on frame F from buffer
7131 CONTENTS. END is the end of the buffer. Value is non-zero if
7132 successful. */
333b20bb
GM		 7133
7134static int
5be6c3b0 7135xbm_load_image (f, img, contents, end)
333b20bb
GM		 7136 struct frame *f;
7137 struct image *img;
5be6c3b0 7138 char *contents, *end;
333b20bb
GM		 7139{
7140 int rc;
7141 unsigned char *data;
7142 int success_p = 0;
333b20bb 7143
5be6c3b0 7144 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
333b20bb
GM		 7145 if (rc)
7146 {
7147 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7148 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
7149 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
7150 Lisp_Object value;
7151
7152 xassert (img->width > 0 && img->height > 0);
7153
7154 /* Get foreground and background colors, maybe allocate colors. */
7155 value = image_spec_value (img->spec, QCforeground, NULL);
7156 if (!NILP (value))
7157 foreground = x_alloc_image_color (f, img, value, foreground);
333b20bb
GM		 7158 value = image_spec_value (img->spec, QCbackground, NULL);
7159 if (!NILP (value))
f20a3b7a
MB		 7160 {
7161 background = x_alloc_image_color (f, img, value, background);
7162 img->background = background;
7163 img->background_valid = 1;
7164 }
333b20bb 7165
333b20bb
GM		 7166 img->pixmap
7167 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7168 FRAME_X_WINDOW (f),
7169 data,
7170 img->width, img->height,
7171 foreground, background,
7172 depth);
7173 xfree (data);
7174
dd00328a 7175 if (img->pixmap == None)
333b20bb
GM		 7176 {
7177 x_clear_image (f, img);
5be6c3b0 7178 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
333b20bb
GM		 7179 }
7180 else
7181 success_p = 1;
333b20bb
GM		 7182 }
7183 else
45158a91 7184 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
333b20bb 7185
333b20bb
GM		 7186 return success_p;
7187}
7188
7189
5be6c3b0
GM		 7190/* Value is non-zero if DATA looks like an in-memory XBM file. */
7191
7192static int
7193xbm_file_p (data)
7194 Lisp_Object data;
7195{
7196 int w, h;
7197 return (STRINGP (data)
7198 && xbm_read_bitmap_data (XSTRING (data)->data,
7199 (XSTRING (data)->data
7200 + STRING_BYTES (XSTRING (data))),
7201 &w, &h, NULL));
7202}
7203
7204
333b20bb
GM		 7205/* Fill image IMG which is used on frame F with pixmap data. Value is
7206 non-zero if successful. */
7207
7208static int
7209xbm_load (f, img)
7210 struct frame *f;
7211 struct image *img;
7212{
7213 int success_p = 0;
7214 Lisp_Object file_name;
7215
7216 xassert (xbm_image_p (img->spec));
7217
7218 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7219 file_name = image_spec_value (img->spec, QCfile, NULL);
7220 if (STRINGP (file_name))
5be6c3b0
GM		 7221 {
7222 Lisp_Object file;
7223 char *contents;
7224 int size;
7225 struct gcpro gcpro1;
7226
7227 file = x_find_image_file (file_name);
7228 GCPRO1 (file);
7229 if (!STRINGP (file))
7230 {
7231 image_error ("Cannot find image file `%s'", file_name, Qnil);
7232 UNGCPRO;
7233 return 0;
7234 }
7235
7236 contents = slurp_file (XSTRING (file)->data, &size);
7237 if (contents == NULL)
7238 {
7239 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
7240 UNGCPRO;
7241 return 0;
7242 }
7243
7244 success_p = xbm_load_image (f, img, contents, contents + size);
7245 UNGCPRO;
7246 }
333b20bb
GM		 7247 else
7248 {
7249 struct image_keyword fmt[XBM_LAST];
7250 Lisp_Object data;
7251 int depth;
7252 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
7253 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
7254 char *bits;
9b207e8e 7255 int parsed_p;
5be6c3b0
GM		 7256 int in_memory_file_p = 0;
7257
7258 /* See if data looks like an in-memory XBM file. */
7259 data = image_spec_value (img->spec, QCdata, NULL);
7260 in_memory_file_p = xbm_file_p (data);
333b20bb 7261
5be6c3b0 7262 /* Parse the image specification. */
333b20bb 7263 bcopy (xbm_format, fmt, sizeof fmt);
bfd2209f 7264 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
333b20bb
GM		 7265 xassert (parsed_p);
7266
7267 /* Get specified width, and height. */
5be6c3b0
GM		 7268 if (!in_memory_file_p)
7269 {
7270 img->width = XFASTINT (fmt[XBM_WIDTH].value);
7271 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
7272 xassert (img->width > 0 && img->height > 0);
7273 }
333b20bb 7274
333b20bb 7275 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM		 7276 if (fmt[XBM_FOREGROUND].count
7277 && STRINGP (fmt[XBM_FOREGROUND].value))
333b20bb
GM		 7278 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
7279 foreground);
6f1be3b9
GM		 7280 if (fmt[XBM_BACKGROUND].count
7281 && STRINGP (fmt[XBM_BACKGROUND].value))
333b20bb
GM		 7282 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
7283 background);
7284
5be6c3b0
GM		 7285 if (in_memory_file_p)
7286 success_p = xbm_load_image (f, img, XSTRING (data)->data,
7287 (XSTRING (data)->data
7288 + STRING_BYTES (XSTRING (data))));
7289 else
333b20bb 7290 {
5be6c3b0
GM		 7291 if (VECTORP (data))
7292 {
7293 int i;
7294 char *p;
7295 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
333b20bb 7296
5be6c3b0
GM		 7297 p = bits = (char *) alloca (nbytes * img->height);
7298 for (i = 0; i < img->height; ++i, p += nbytes)
7299 {
7300 Lisp_Object line = XVECTOR (data)->contents[i];
7301 if (STRINGP (line))
7302 bcopy (XSTRING (line)->data, p, nbytes);
7303 else
7304 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
7305 }
7306 }
7307 else if (STRINGP (data))
7308 bits = XSTRING (data)->data;
7309 else
7310 bits = XBOOL_VECTOR (data)->data;
7311
7312 /* Create the pixmap. */
7313 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7314 img->pixmap
7315 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7316 FRAME_X_WINDOW (f),
7317 bits,
7318 img->width, img->height,
7319 foreground, background,
7320 depth);
7321 if (img->pixmap)
7322 success_p = 1;
7323 else
333b20bb 7324 {
5be6c3b0
GM		 7325 image_error ("Unable to create pixmap for XBM image `%s'",
7326 img->spec, Qnil);
7327 x_clear_image (f, img);
333b20bb
GM		 7328 }
7329 }
333b20bb
GM		 7330 }
7331
7332 return success_p;
7333}
7334
7335
7336\f
7337/***********************************************************************
7338 XPM images
7339 ***********************************************************************/
7340
7341#if HAVE_XPM
7342
7343static int xpm_image_p P_ ((Lisp_Object object));
7344static int xpm_load P_ ((struct frame *f, struct image *img));
7345static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
7346
7347#include "X11/xpm.h"
7348
7349/* The symbol `xpm' identifying XPM-format images. */
7350
7351Lisp_Object Qxpm;
7352
7353/* Indices of image specification fields in xpm_format, below. */
7354
7355enum xpm_keyword_index
7356{
7357 XPM_TYPE,
7358 XPM_FILE,
7359 XPM_DATA,
7360 XPM_ASCENT,
7361 XPM_MARGIN,
7362 XPM_RELIEF,
7363 XPM_ALGORITHM,
7364 XPM_HEURISTIC_MASK,
4a8e312c 7365 XPM_MASK,
333b20bb 7366 XPM_COLOR_SYMBOLS,
f20a3b7a 7367 XPM_BACKGROUND,
333b20bb
GM		 7368 XPM_LAST
7369};
7370
7371/* Vector of image_keyword structures describing the format
7372 of valid XPM image specifications. */
7373
7374static struct image_keyword xpm_format[XPM_LAST] =
7375{
7376 {":type", IMAGE_SYMBOL_VALUE, 1},
7377 {":file", IMAGE_STRING_VALUE, 0},
7378 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 7379 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 7380 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 7381 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 7382 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 7383 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 7384 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 7385 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7386 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 7387};
7388
7389/* Structure describing the image type XBM. */
7390
7391static struct image_type xpm_type =
7392{
7393 &Qxpm,
7394 xpm_image_p,
7395 xpm_load,
7396 x_clear_image,
7397 NULL
7398};
7399
7400
b243755a
GM		 7401/* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7402 functions for allocating image colors. Our own functions handle
7403 color allocation failures more gracefully than the ones on the XPM
7404 lib. */
7405
7406#if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7407#define ALLOC_XPM_COLORS
7408#endif
7409
7410#ifdef ALLOC_XPM_COLORS
7411
f72c62ad 7412static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
b243755a
GM		 7413static void xpm_free_color_cache P_ ((void));
7414static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
f72c62ad
GM		 7415static int xpm_color_bucket P_ ((char *));
7416static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
7417 XColor *, int));
b243755a
GM		 7418
7419/* An entry in a hash table used to cache color definitions of named
7420 colors. This cache is necessary to speed up XPM image loading in
7421 case we do color allocations ourselves. Without it, we would need
7422 a call to XParseColor per pixel in the image. */
7423
7424struct xpm_cached_color
7425{
7426 /* Next in collision chain. */
7427 struct xpm_cached_color *next;
7428
7429 /* Color definition (RGB and pixel color). */
7430 XColor color;
7431
7432 /* Color name. */
7433 char name[1];
7434};
7435
7436/* The hash table used for the color cache, and its bucket vector
7437 size. */
7438
7439#define XPM_COLOR_CACHE_BUCKETS 1001
7440struct xpm_cached_color **xpm_color_cache;
7441
b243755a
GM		 7442/* Initialize the color cache. */
7443
7444static void
f72c62ad
GM		 7445xpm_init_color_cache (f, attrs)
7446 struct frame *f;
7447 XpmAttributes *attrs;
b243755a
GM		 7448{
7449 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
7450 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
7451 memset (xpm_color_cache, 0, nbytes);
7452 init_color_table ();
f72c62ad
GM		 7453
7454 if (attrs->valuemask & XpmColorSymbols)
7455 {
7456 int i;
7457 XColor color;
7458
7459 for (i = 0; i < attrs->numsymbols; ++i)
7460 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7461 attrs->colorsymbols[i].value, &color))
7462 {
7463 color.pixel = lookup_rgb_color (f, color.red, color.green,
7464 color.blue);
7465 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
7466 }
7467 }
b243755a
GM		 7468}
7469
7470
7471/* Free the color cache. */
7472
7473static void
7474xpm_free_color_cache ()
7475{
7476 struct xpm_cached_color *p, *next;
7477 int i;
7478
7479 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
7480 for (p = xpm_color_cache[i]; p; p = next)
7481 {
7482 next = p->next;
7483 xfree (p);
7484 }
7485
7486 xfree (xpm_color_cache);
7487 xpm_color_cache = NULL;
7488 free_color_table ();
7489}
7490
7491
f72c62ad
GM		 7492/* Return the bucket index for color named COLOR_NAME in the color
7493 cache. */
7494
7495static int
7496xpm_color_bucket (color_name)
7497 char *color_name;
7498{
7499 unsigned h = 0;
7500 char *s;
7501
7502 for (s = color_name; *s; ++s)
7503 h = (h << 2) ^ *s;
7504 return h %= XPM_COLOR_CACHE_BUCKETS;
7505}
7506
7507
7508/* On frame F, cache values COLOR for color with name COLOR_NAME.
7509 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7510 entry added. */
7511
7512static struct xpm_cached_color *
7513xpm_cache_color (f, color_name, color, bucket)
7514 struct frame *f;
7515 char *color_name;
7516 XColor *color;
7517 int bucket;
7518{
7519 size_t nbytes;
7520 struct xpm_cached_color *p;
7521
7522 if (bucket < 0)
7523 bucket = xpm_color_bucket (color_name);
7524
7525 nbytes = sizeof *p + strlen (color_name);
7526 p = (struct xpm_cached_color *) xmalloc (nbytes);
7527 strcpy (p->name, color_name);
7528 p->color = *color;
7529 p->next = xpm_color_cache[bucket];
7530 xpm_color_cache[bucket] = p;
7531 return p;
7532}
7533
7534
b243755a
GM		 7535/* Look up color COLOR_NAME for frame F in the color cache. If found,
7536 return the cached definition in *COLOR. Otherwise, make a new
7537 entry in the cache and allocate the color. Value is zero if color
7538 allocation failed. */
7539
7540static int
7541xpm_lookup_color (f, color_name, color)
7542 struct frame *f;
7543 char *color_name;
7544 XColor *color;
7545{
b243755a 7546 struct xpm_cached_color *p;
83676598 7547 int h = xpm_color_bucket (color_name);
b243755a
GM		 7548
7549 for (p = xpm_color_cache[h]; p; p = p->next)
7550 if (strcmp (p->name, color_name) == 0)
7551 break;
7552
7553 if (p != NULL)
7554 *color = p->color;
7555 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7556 color_name, color))
7557 {
b243755a
GM		 7558 color->pixel = lookup_rgb_color (f, color->red, color->green,
7559 color->blue);
f72c62ad 7560 p = xpm_cache_color (f, color_name, color, h);
b243755a 7561 }
f72c62ad 7562
b243755a
GM		 7563 return p != NULL;
7564}
7565
7566
7567/* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7568 CLOSURE is a pointer to the frame on which we allocate the
7569 color. Return in *COLOR the allocated color. Value is non-zero
7570 if successful. */
7571
7572static int
7573xpm_alloc_color (dpy, cmap, color_name, color, closure)
7574 Display *dpy;
7575 Colormap cmap;
7576 char *color_name;
7577 XColor *color;
7578 void *closure;
7579{
7580 return xpm_lookup_color ((struct frame *) closure, color_name, color);
7581}
7582
7583
7584/* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7585 is a pointer to the frame on which we allocate the color. Value is
7586 non-zero if successful. */
7587
7588static int
7589xpm_free_colors (dpy, cmap, pixels, npixels, closure)
7590 Display *dpy;
7591 Colormap cmap;
7592 Pixel *pixels;
7593 int npixels;
7594 void *closure;
7595{
7596 return 1;
7597}
7598
7599#endif /* ALLOC_XPM_COLORS */
7600
7601
333b20bb
GM		 7602/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7603 for XPM images. Such a list must consist of conses whose car and
7604 cdr are strings. */
7605
7606static int
7607xpm_valid_color_symbols_p (color_symbols)
7608 Lisp_Object color_symbols;
7609{
7610 while (CONSP (color_symbols))
7611 {
7612 Lisp_Object sym = XCAR (color_symbols);
7613 if (!CONSP (sym)
7614 || !STRINGP (XCAR (sym))
7615 || !STRINGP (XCDR (sym)))
7616 break;
7617 color_symbols = XCDR (color_symbols);
7618 }
7619
7620 return NILP (color_symbols);
7621}
7622
7623
7624/* Value is non-zero if OBJECT is a valid XPM image specification. */
7625
7626static int
7627xpm_image_p (object)
7628 Lisp_Object object;
7629{
7630 struct image_keyword fmt[XPM_LAST];
7631 bcopy (xpm_format, fmt, sizeof fmt);
bfd2209f 7632 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
333b20bb
GM		 7633 /* Either `:file' or `:data' must be present. */
7634 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
7635 /* Either no `:color-symbols' or it's a list of conses
7636 whose car and cdr are strings. */
7637 && (fmt[XPM_COLOR_SYMBOLS].count == 0
7c7ff7f5 7638 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
333b20bb
GM		 7639}
7640
7641
7642/* Load image IMG which will be displayed on frame F. Value is
7643 non-zero if successful. */
7644
7645static int
7646xpm_load (f, img)
7647 struct frame *f;
7648 struct image *img;
7649{
9b207e8e 7650 int rc;
333b20bb
GM		 7651 XpmAttributes attrs;
7652 Lisp_Object specified_file, color_symbols;
7653
7654 /* Configure the XPM lib. Use the visual of frame F. Allocate
7655 close colors. Return colors allocated. */
7656 bzero (&attrs, sizeof attrs);
9b2956e2
GM		 7657 attrs.visual = FRAME_X_VISUAL (f);
7658 attrs.colormap = FRAME_X_COLORMAP (f);
333b20bb 7659 attrs.valuemask |= XpmVisual;
9b2956e2 7660 attrs.valuemask |= XpmColormap;
b243755a
GM		 7661
7662#ifdef ALLOC_XPM_COLORS
7663 /* Allocate colors with our own functions which handle
7664 failing color allocation more gracefully. */
7665 attrs.color_closure = f;
7666 attrs.alloc_color = xpm_alloc_color;
7667 attrs.free_colors = xpm_free_colors;
7668 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
7669#else /* not ALLOC_XPM_COLORS */
7670 /* Let the XPM lib allocate colors. */
333b20bb 7671 attrs.valuemask |= XpmReturnAllocPixels;
e4c082be 7672#ifdef XpmAllocCloseColors
333b20bb
GM		 7673 attrs.alloc_close_colors = 1;
7674 attrs.valuemask |= XpmAllocCloseColors;
b243755a 7675#else /* not XpmAllocCloseColors */
e4c082be
RS		 7676 attrs.closeness = 600;
7677 attrs.valuemask |= XpmCloseness;
b243755a
GM		 7678#endif /* not XpmAllocCloseColors */
7679#endif /* ALLOC_XPM_COLORS */
333b20bb
GM		 7680
7681 /* If image specification contains symbolic color definitions, add
7682 these to `attrs'. */
7683 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
7684 if (CONSP (color_symbols))
7685 {
7686 Lisp_Object tail;
7687 XpmColorSymbol *xpm_syms;
7688 int i, size;
7689
7690 attrs.valuemask |= XpmColorSymbols;
7691
7692 /* Count number of symbols. */
7693 attrs.numsymbols = 0;
7694 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
7695 ++attrs.numsymbols;
7696
7697 /* Allocate an XpmColorSymbol array. */
7698 size = attrs.numsymbols * sizeof *xpm_syms;
7699 xpm_syms = (XpmColorSymbol *) alloca (size);
7700 bzero (xpm_syms, size);
7701 attrs.colorsymbols = xpm_syms;
7702
7703 /* Fill the color symbol array. */
7704 for (tail = color_symbols, i = 0;
7705 CONSP (tail);
7706 ++i, tail = XCDR (tail))
7707 {
7708 Lisp_Object name = XCAR (XCAR (tail));
7709 Lisp_Object color = XCDR (XCAR (tail));
7710 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
7711 strcpy (xpm_syms[i].name, XSTRING (name)->data);
7712 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
7713 strcpy (xpm_syms[i].value, XSTRING (color)->data);
7714 }
7715 }
7716
7717 /* Create a pixmap for the image, either from a file, or from a
7718 string buffer containing data in the same format as an XPM file. */
b243755a 7719#ifdef ALLOC_XPM_COLORS
f72c62ad 7720 xpm_init_color_cache (f, &attrs);
b243755a
GM		 7721#endif
7722
333b20bb
GM		 7723 specified_file = image_spec_value (img->spec, QCfile, NULL);
7724 if (STRINGP (specified_file))
7725 {
7726 Lisp_Object file = x_find_image_file (specified_file);
7727 if (!STRINGP (file))
7728 {
45158a91 7729 image_error ("Cannot find image file `%s'", specified_file, Qnil);
333b20bb
GM		 7730 return 0;
7731 }
7732
7733 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7734 XSTRING (file)->data, &img->pixmap, &img->mask,
7735 &attrs);
7736 }
7737 else
7738 {
7739 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
7740 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7741 XSTRING (buffer)->data,
7742 &img->pixmap, &img->mask,
7743 &attrs);
7744 }
333b20bb
GM		 7745
7746 if (rc == XpmSuccess)
7747 {
b243755a
GM		 7748#ifdef ALLOC_XPM_COLORS
7749 img->colors = colors_in_color_table (&img->ncolors);
7750#else /* not ALLOC_XPM_COLORS */
f47a9ec4
KR		 7751 int i;
7752
333b20bb
GM		 7753 img->ncolors = attrs.nalloc_pixels;
7754 img->colors = (unsigned long *) xmalloc (img->ncolors
7755 * sizeof *img->colors);
7756 for (i = 0; i < attrs.nalloc_pixels; ++i)
3b4ae1cc
GM		 7757 {
7758 img->colors[i] = attrs.alloc_pixels[i];
7759#ifdef DEBUG_X_COLORS
7760 register_color (img->colors[i]);
7761#endif
7762 }
b243755a 7763#endif /* not ALLOC_XPM_COLORS */
333b20bb
GM		 7764
7765 img->width = attrs.width;
7766 img->height = attrs.height;
7767 xassert (img->width > 0 && img->height > 0);
7768
7769 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
333b20bb 7770 XpmFreeAttributes (&attrs);
333b20bb
GM		 7771 }
7772 else
7773 {
7774 switch (rc)
7775 {
7776 case XpmOpenFailed:
7777 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
7778 break;
7779
7780 case XpmFileInvalid:
7781 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
7782 break;
7783
7784 case XpmNoMemory:
7785 image_error ("Out of memory (%s)", img->spec, Qnil);
7786 break;
7787
7788 case XpmColorFailed:
7789 image_error ("Color allocation error (%s)", img->spec, Qnil);
7790 break;
7791
7792 default:
7793 image_error ("Unknown error (%s)", img->spec, Qnil);
7794 break;
7795 }
7796 }
7797
b243755a
GM		 7798#ifdef ALLOC_XPM_COLORS
7799 xpm_free_color_cache ();
7800#endif
333b20bb
GM		 7801 return rc == XpmSuccess;
7802}
7803
7804#endif /* HAVE_XPM != 0 */
7805
7806\f
7807/***********************************************************************
7808 Color table
7809 ***********************************************************************/
7810
7811/* An entry in the color table mapping an RGB color to a pixel color. */
7812
7813struct ct_color
7814{
7815 int r, g, b;
7816 unsigned long pixel;
7817
7818 /* Next in color table collision list. */
7819 struct ct_color *next;
7820};
7821
7822/* The bucket vector size to use. Must be prime. */
7823
7824#define CT_SIZE 101
7825
7826/* Value is a hash of the RGB color given by R, G, and B. */
7827
7828#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7829
7830/* The color hash table. */
7831
7832struct ct_color **ct_table;
7833
7834/* Number of entries in the color table. */
7835
7836int ct_colors_allocated;
7837
333b20bb
GM		 7838/* Initialize the color table. */
7839
7840static void
7841init_color_table ()
7842{
7843 int size = CT_SIZE * sizeof (*ct_table);
7844 ct_table = (struct ct_color **) xmalloc (size);
7845 bzero (ct_table, size);
7846 ct_colors_allocated = 0;
7847}
7848
7849
7850/* Free memory associated with the color table. */
7851
7852static void
7853free_color_table ()
7854{
7855 int i;
7856 struct ct_color *p, *next;
7857
7858 for (i = 0; i < CT_SIZE; ++i)
7859 for (p = ct_table[i]; p; p = next)
7860 {
7861 next = p->next;
7862 xfree (p);
7863 }
7864
7865 xfree (ct_table);
7866 ct_table = NULL;
7867}
7868
7869
7870/* Value is a pixel color for RGB color R, G, B on frame F. If an
7871 entry for that color already is in the color table, return the
7872 pixel color of that entry. Otherwise, allocate a new color for R,
7873 G, B, and make an entry in the color table. */
7874
7875static unsigned long
7876lookup_rgb_color (f, r, g, b)
7877 struct frame *f;
7878 int r, g, b;
7879{
7880 unsigned hash = CT_HASH_RGB (r, g, b);
7881 int i = hash % CT_SIZE;
7882 struct ct_color *p;
7883
7884 for (p = ct_table[i]; p; p = p->next)
7885 if (p->r == r && p->g == g && p->b == b)
7886 break;
7887
7888 if (p == NULL)
7889 {
7890 XColor color;
7891 Colormap cmap;
7892 int rc;
7893
7894 color.red = r;
7895 color.green = g;
7896 color.blue = b;
7897
9b2956e2 7898 cmap = FRAME_X_COLORMAP (f);
d62c8769 7899 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM		 7900
7901 if (rc)
7902 {
7903 ++ct_colors_allocated;
7904
7905 p = (struct ct_color *) xmalloc (sizeof *p);
7906 p->r = r;
7907 p->g = g;
7908 p->b = b;
7909 p->pixel = color.pixel;
7910 p->next = ct_table[i];
7911 ct_table[i] = p;
7912 }
7913 else
7914 return FRAME_FOREGROUND_PIXEL (f);
7915 }
7916
7917 return p->pixel;
7918}
7919
7920
7921/* Look up pixel color PIXEL which is used on frame F in the color
7922 table. If not already present, allocate it. Value is PIXEL. */
7923
7924static unsigned long
7925lookup_pixel_color (f, pixel)
7926 struct frame *f;
7927 unsigned long pixel;
7928{
7929 int i = pixel % CT_SIZE;
7930 struct ct_color *p;
7931
7932 for (p = ct_table[i]; p; p = p->next)
7933 if (p->pixel == pixel)
7934 break;
7935
7936 if (p == NULL)
7937 {
7938 XColor color;
7939 Colormap cmap;
7940 int rc;
7941
9b2956e2 7942 cmap = FRAME_X_COLORMAP (f);
333b20bb 7943 color.pixel = pixel;
a31fedb7 7944 x_query_color (f, &color);
d62c8769 7945 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM		 7946
7947 if (rc)
7948 {
7949 ++ct_colors_allocated;
7950
7951 p = (struct ct_color *) xmalloc (sizeof *p);
7952 p->r = color.red;
7953 p->g = color.green;
7954 p->b = color.blue;
7955 p->pixel = pixel;
7956 p->next = ct_table[i];
7957 ct_table[i] = p;
7958 }
7959 else
7960 return FRAME_FOREGROUND_PIXEL (f);
7961 }
7962
7963 return p->pixel;
7964}
7965
7966
7967/* Value is a vector of all pixel colors contained in the color table,
7968 allocated via xmalloc. Set *N to the number of colors. */
7969
7970static unsigned long *
7971colors_in_color_table (n)
7972 int *n;
7973{
7974 int i, j;
7975 struct ct_color *p;
7976 unsigned long *colors;
7977
7978 if (ct_colors_allocated == 0)
7979 {
7980 *n = 0;
7981 colors = NULL;
7982 }
7983 else
7984 {
7985 colors = (unsigned long *) xmalloc (ct_colors_allocated
7986 * sizeof *colors);
7987 *n = ct_colors_allocated;
7988
7989 for (i = j = 0; i < CT_SIZE; ++i)
7990 for (p = ct_table[i]; p; p = p->next)
7991 colors[j++] = p->pixel;
7992 }
7993
7994 return colors;
7995}
7996
7997
7998\f
7999/***********************************************************************
8000 Algorithms
8001 ***********************************************************************/
8002
4a8e312c
GM		 8003static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
8004static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
8005static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
8006
d2dc8167 8007/* Non-zero means draw a cross on images having `:conversion
14819cb3
GM		 8008 disabled'. */
8009
8010int cross_disabled_images;
8011
4a8e312c
GM		 8012/* Edge detection matrices for different edge-detection
8013 strategies. */
8014
8015static int emboss_matrix[9] = {
8016 /* x - 1 x x + 1 */
8017 2, -1, 0, /* y - 1 */
8018 -1, 0, 1, /* y */
8019 0, 1, -2 /* y + 1 */
8020};
333b20bb 8021
4a8e312c
GM		 8022static int laplace_matrix[9] = {
8023 /* x - 1 x x + 1 */
8024 1, 0, 0, /* y - 1 */
8025 0, 0, 0, /* y */
8026 0, 0, -1 /* y + 1 */
8027};
333b20bb 8028
14819cb3
GM		 8029/* Value is the intensity of the color whose red/green/blue values
8030 are R, G, and B. */
8031
8032#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8033
333b20bb 8034
4a8e312c
GM		 8035/* On frame F, return an array of XColor structures describing image
8036 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8037 non-zero means also fill the red/green/blue members of the XColor
8038 structures. Value is a pointer to the array of XColors structures,
8039 allocated with xmalloc; it must be freed by the caller. */
8040
8041static XColor *
8042x_to_xcolors (f, img, rgb_p)
333b20bb 8043 struct frame *f;
4a8e312c
GM		 8044 struct image *img;
8045 int rgb_p;
333b20bb 8046{
4a8e312c
GM		 8047 int x, y;
8048 XColor *colors, *p;
8049 XImage *ximg;
333b20bb 8050
4a8e312c
GM		 8051 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
8052
8053 /* Get the X image IMG->pixmap. */
8054 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
8055 0, 0, img->width, img->height, ~0, ZPixmap);
333b20bb 8056
4a8e312c
GM		 8057 /* Fill the `pixel' members of the XColor array. I wished there
8058 were an easy and portable way to circumvent XGetPixel. */
8059 p = colors;
8060 for (y = 0; y < img->height; ++y)
8061 {
8062 XColor *row = p;
8063
8064 for (x = 0; x < img->width; ++x, ++p)
8065 p->pixel = XGetPixel (ximg, x, y);
8066
8067 if (rgb_p)
a31fedb7 8068 x_query_colors (f, row, img->width);
4a8e312c
GM		 8069 }
8070
8071 XDestroyImage (ximg);
4a8e312c 8072 return colors;
333b20bb
GM		 8073}
8074
8075
4a8e312c
GM		 8076/* Create IMG->pixmap from an array COLORS of XColor structures, whose
8077 RGB members are set. F is the frame on which this all happens.
8078 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
333b20bb
GM		 8079
8080static void
4a8e312c 8081x_from_xcolors (f, img, colors)
333b20bb 8082 struct frame *f;
4a8e312c
GM		 8083 struct image *img;
8084 XColor *colors;
333b20bb 8085{
4a8e312c
GM		 8086 int x, y;
8087 XImage *oimg;
8088 Pixmap pixmap;
8089 XColor *p;
8090
4a8e312c 8091 init_color_table ();
333b20bb 8092
4a8e312c
GM		 8093 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
8094 &oimg, &pixmap);
8095 p = colors;
8096 for (y = 0; y < img->height; ++y)
8097 for (x = 0; x < img->width; ++x, ++p)
8098 {
8099 unsigned long pixel;
8100 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
8101 XPutPixel (oimg, x, y, pixel);
8102 }
8103
8104 xfree (colors);
dd00328a 8105 x_clear_image_1 (f, img, 1, 0, 1);
4a8e312c
GM		 8106
8107 x_put_x_image (f, oimg, pixmap, img->width, img->height);
8108 x_destroy_x_image (oimg);
8109 img->pixmap = pixmap;
8110 img->colors = colors_in_color_table (&img->ncolors);
8111 free_color_table ();
333b20bb
GM		 8112}
8113
8114
4a8e312c
GM		 8115/* On frame F, perform edge-detection on image IMG.
8116
8117 MATRIX is a nine-element array specifying the transformation
8118 matrix. See emboss_matrix for an example.
8119
8120 COLOR_ADJUST is a color adjustment added to each pixel of the
8121 outgoing image. */
333b20bb
GM		 8122
8123static void
4a8e312c 8124x_detect_edges (f, img, matrix, color_adjust)
333b20bb
GM		 8125 struct frame *f;
8126 struct image *img;
4a8e312c 8127 int matrix[9], color_adjust;
333b20bb 8128{
4a8e312c
GM		 8129 XColor *colors = x_to_xcolors (f, img, 1);
8130 XColor *new, *p;
8131 int x, y, i, sum;
333b20bb 8132
4a8e312c
GM		 8133 for (i = sum = 0; i < 9; ++i)
8134 sum += abs (matrix[i]);
333b20bb 8135
4a8e312c 8136#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
333b20bb 8137
4a8e312c 8138 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
333b20bb 8139
4a8e312c
GM		 8140 for (y = 0; y < img->height; ++y)
8141 {
8142 p = COLOR (new, 0, y);
8143 p->red = p->green = p->blue = 0xffff/2;
8144 p = COLOR (new, img->width - 1, y);
8145 p->red = p->green = p->blue = 0xffff/2;
8146 }
8147
8148 for (x = 1; x < img->width - 1; ++x)
8149 {
8150 p = COLOR (new, x, 0);
8151 p->red = p->green = p->blue = 0xffff/2;
8152 p = COLOR (new, x, img->height - 1);
8153 p->red = p->green = p->blue = 0xffff/2;
8154 }
333b20bb 8155
4a8e312c 8156 for (y = 1; y < img->height - 1; ++y)
333b20bb 8157 {
4a8e312c
GM		 8158 p = COLOR (new, 1, y);
8159
8160 for (x = 1; x < img->width - 1; ++x, ++p)
8161 {
14819cb3 8162 int r, g, b, y1, x1;
4a8e312c
GM		 8163
8164 r = g = b = i = 0;
8165 for (y1 = y - 1; y1 < y + 2; ++y1)
8166 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
8167 if (matrix[i])
8168 {
8169 XColor *t = COLOR (colors, x1, y1);
8170 r += matrix[i] * t->red;
8171 g += matrix[i] * t->green;
8172 b += matrix[i] * t->blue;
8173 }
333b20bb 8174
4a8e312c
GM		 8175 r = (r / sum + color_adjust) & 0xffff;
8176 g = (g / sum + color_adjust) & 0xffff;
8177 b = (b / sum + color_adjust) & 0xffff;
14819cb3 8178 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
333b20bb 8179 }
333b20bb
GM		 8180 }
8181
4a8e312c
GM		 8182 xfree (colors);
8183 x_from_xcolors (f, img, new);
333b20bb 8184
4a8e312c
GM		 8185#undef COLOR
8186}
8187
8188
8189/* Perform the pre-defined `emboss' edge-detection on image IMG
8190 on frame F. */
8191
8192static void
8193x_emboss (f, img)
8194 struct frame *f;
8195 struct image *img;
8196{
8197 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
8198}
8199
8200
8201/* Perform the pre-defined `laplace' edge-detection on image IMG
8202 on frame F. */
8203
8204static void
8205x_laplace (f, img)
8206 struct frame *f;
8207 struct image *img;
8208{
8209 x_detect_edges (f, img, laplace_matrix, 45000);
8210}
8211
8212
8213/* Perform edge-detection on image IMG on frame F, with specified
8214 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8215
8216 MATRIX must be either
8217
8218 - a list of at least 9 numbers in row-major form
8219 - a vector of at least 9 numbers
8220
8221 COLOR_ADJUST nil means use a default; otherwise it must be a
8222 number. */
8223
8224static void
8225x_edge_detection (f, img, matrix, color_adjust)
8226 struct frame *f;
8227 struct image *img;
8228 Lisp_Object matrix, color_adjust;
8229{
8230 int i = 0;
8231 int trans[9];
333b20bb 8232
4a8e312c
GM		 8233 if (CONSP (matrix))
8234 {
8235 for (i = 0;
8236 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
8237 ++i, matrix = XCDR (matrix))
8238 trans[i] = XFLOATINT (XCAR (matrix));
8239 }
8240 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
8241 {
8242 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
8243 trans[i] = XFLOATINT (AREF (matrix, i));
8244 }
333b20bb 8245
4a8e312c
GM		 8246 if (NILP (color_adjust))
8247 color_adjust = make_number (0xffff / 2);
333b20bb 8248
4a8e312c
GM		 8249 if (i == 9 && NUMBERP (color_adjust))
8250 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
333b20bb
GM		 8251}
8252
8253
14819cb3
GM		 8254/* Transform image IMG on frame F so that it looks disabled. */
8255
8256static void
8257x_disable_image (f, img)
8258 struct frame *f;
8259 struct image *img;
8260{
8261 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
dd00328a 8262
14819cb3
GM		 8263 if (dpyinfo->n_planes >= 2)
8264 {
8265 /* Color (or grayscale). Convert to gray, and equalize. Just
8266 drawing such images with a stipple can look very odd, so
8267 we're using this method instead. */
8268 XColor *colors = x_to_xcolors (f, img, 1);
8269 XColor *p, *end;
8270 const int h = 15000;
8271 const int l = 30000;
8272
8273 for (p = colors, end = colors + img->width * img->height;
8274 p < end;
8275 ++p)
8276 {
8277 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
8278 int i2 = (0xffff - h - l) * i / 0xffff + l;
8279 p->red = p->green = p->blue = i2;
8280 }
8281
8282 x_from_xcolors (f, img, colors);
8283 }
8284
8285 /* Draw a cross over the disabled image, if we must or if we
8286 should. */
8287 if (dpyinfo->n_planes < 2 || cross_disabled_images)
8288 {
8289 Display *dpy = FRAME_X_DISPLAY (f);
8290 GC gc;
8291
14819cb3
GM		 8292 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
8293 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
8294 XDrawLine (dpy, img->pixmap, gc, 0, 0,
8295 img->width - 1, img->height - 1);
8296 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
8297 img->width - 1, 0);
8298 XFreeGC (dpy, gc);
8299
8300 if (img->mask)
8301 {
8302 gc = XCreateGC (dpy, img->mask, 0, NULL);
8303 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
8304 XDrawLine (dpy, img->mask, gc, 0, 0,
8305 img->width - 1, img->height - 1);
8306 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
8307 img->width - 1, 0);
8308 XFreeGC (dpy, gc);
8309 }
14819cb3
GM		 8310 }
8311}
8312
8313
333b20bb
GM		 8314/* Build a mask for image IMG which is used on frame F. FILE is the
8315 name of an image file, for error messages. HOW determines how to
fcf431dc
GM		 8316 determine the background color of IMG. If it is a list '(R G B)',
8317 with R, G, and B being integers >= 0, take that as the color of the
8318 background. Otherwise, determine the background color of IMG
8319 heuristically. Value is non-zero if successful. */
333b20bb
GM		 8320
8321static int
45158a91 8322x_build_heuristic_mask (f, img, how)
333b20bb 8323 struct frame *f;
333b20bb
GM		 8324 struct image *img;
8325 Lisp_Object how;
8326{
8327 Display *dpy = FRAME_X_DISPLAY (f);
333b20bb 8328 XImage *ximg, *mask_img;
f20a3b7a 8329 int x, y, rc, use_img_background;
8ec8a5ec 8330 unsigned long bg = 0;
333b20bb 8331
4a8e312c
GM		 8332 if (img->mask)
8333 {
8334 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 8335 img->mask = None;
f20a3b7a 8336 img->background_transparent_valid = 0;
4a8e312c 8337 }
dd00328a 8338
333b20bb 8339 /* Create an image and pixmap serving as mask. */
45158a91 8340 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
333b20bb
GM		 8341 &mask_img, &img->mask);
8342 if (!rc)
28c7826c 8343 return 0;
333b20bb
GM		 8344
8345 /* Get the X image of IMG->pixmap. */
8346 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
8347 ~0, ZPixmap);
8348
fcf431dc 8349 /* Determine the background color of ximg. If HOW is `(R G B)'
f20a3b7a
MB		 8350 take that as color. Otherwise, use the image's background color. */
8351 use_img_background = 1;
fcf431dc
GM		 8352
8353 if (CONSP (how))
8354 {
cac1daf0 8355 int rgb[3], i;
fcf431dc 8356
cac1daf0 8357 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
fcf431dc
GM		 8358 {
8359 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
8360 how = XCDR (how);
8361 }
8362
8363 if (i == 3 && NILP (how))
8364 {
8365 char color_name[30];
fcf431dc 8366 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
053b3256
GM		 8367 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
8368 use_img_background = 0;
fcf431dc
GM		 8369 }
8370 }
8371
f20a3b7a 8372 if (use_img_background)
43f7c3ea 8373 bg = four_corners_best (ximg, img->width, img->height);
333b20bb
GM		 8374
8375 /* Set all bits in mask_img to 1 whose color in ximg is different
8376 from the background color bg. */
8377 for (y = 0; y < img->height; ++y)
8378 for (x = 0; x < img->width; ++x)
8379 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
8380
f20a3b7a
MB		 8381 /* Fill in the background_transparent field while we have the mask handy. */
8382 image_background_transparent (img, f, mask_img);
8383
333b20bb
GM		 8384 /* Put mask_img into img->mask. */
8385 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8386 x_destroy_x_image (mask_img);
8387 XDestroyImage (ximg);
8388
333b20bb
GM		 8389 return 1;
8390}
8391
8392
8393\f
8394/***********************************************************************
8395 PBM (mono, gray, color)
8396 ***********************************************************************/
8397
8398static int pbm_image_p P_ ((Lisp_Object object));
8399static int pbm_load P_ ((struct frame *f, struct image *img));
63cec32f 8400static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
333b20bb
GM		 8401
8402/* The symbol `pbm' identifying images of this type. */
8403
8404Lisp_Object Qpbm;
8405
8406/* Indices of image specification fields in gs_format, below. */
8407
8408enum pbm_keyword_index
8409{
8410 PBM_TYPE,
8411 PBM_FILE,
63cec32f 8412 PBM_DATA,
333b20bb
GM		 8413 PBM_ASCENT,
8414 PBM_MARGIN,
8415 PBM_RELIEF,
8416 PBM_ALGORITHM,
8417 PBM_HEURISTIC_MASK,
4a8e312c 8418 PBM_MASK,
be0b1fac
GM		 8419 PBM_FOREGROUND,
8420 PBM_BACKGROUND,
333b20bb
GM		 8421 PBM_LAST
8422};
8423
8424/* Vector of image_keyword structures describing the format
8425 of valid user-defined image specifications. */
8426
8427static struct image_keyword pbm_format[PBM_LAST] =
8428{
8429 {":type", IMAGE_SYMBOL_VALUE, 1},
63cec32f
GM		 8430 {":file", IMAGE_STRING_VALUE, 0},
8431 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8432 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8433 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8434 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8435 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 8436 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
be0b1fac 8437 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM		 8438 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8439 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 8440};
8441
8442/* Structure describing the image type `pbm'. */
8443
8444static struct image_type pbm_type =
8445{
8446 &Qpbm,
8447 pbm_image_p,
8448 pbm_load,
8449 x_clear_image,
8450 NULL
8451};
8452
8453
8454/* Return non-zero if OBJECT is a valid PBM image specification. */
8455
8456static int
8457pbm_image_p (object)
8458 Lisp_Object object;
8459{
8460 struct image_keyword fmt[PBM_LAST];
8461
8462 bcopy (pbm_format, fmt, sizeof fmt);
8463
7c7ff7f5 8464 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
333b20bb 8465 return 0;
63cec32f
GM		 8466
8467 /* Must specify either :data or :file. */
8468 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
333b20bb
GM		 8469}
8470
8471
63cec32f
GM		 8472/* Scan a decimal number from *S and return it. Advance *S while
8473 reading the number. END is the end of the string. Value is -1 at
8474 end of input. */
333b20bb
GM		 8475
8476static int
63cec32f
GM		 8477pbm_scan_number (s, end)
8478 unsigned char **s, *end;
333b20bb 8479{
8ec8a5ec 8480 int c = 0, val = -1;
333b20bb 8481
63cec32f 8482 while (*s < end)
333b20bb
GM		 8483 {
8484 /* Skip white-space. */
63cec32f 8485 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM		 8486 ;
8487
8488 if (c == '#')
8489 {
8490 /* Skip comment to end of line. */
63cec32f 8491 while (*s < end && (c = *(*s)++, c != '\n'))
333b20bb
GM		 8492 ;
8493 }
8494 else if (isdigit (c))
8495 {
8496 /* Read decimal number. */
8497 val = c - '0';
63cec32f 8498 while (*s < end && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 8499 val = 10 * val + c - '0';
8500 break;
8501 }
8502 else
8503 break;
8504 }
8505
8506 return val;
8507}
8508
8509
8510/* Load PBM image IMG for use on frame F. */
8511
8512static int
8513pbm_load (f, img)
8514 struct frame *f;
8515 struct image *img;
8516{
333b20bb 8517 int raw_p, x, y;
b6d7acec 8518 int width, height, max_color_idx = 0;
333b20bb
GM		 8519 XImage *ximg;
8520 Lisp_Object file, specified_file;
8521 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
8522 struct gcpro gcpro1;
63cec32f
GM		 8523 unsigned char *contents = NULL;
8524 unsigned char *end, *p;
8525 int size;
333b20bb
GM		 8526
8527 specified_file = image_spec_value (img->spec, QCfile, NULL);
63cec32f 8528 file = Qnil;
333b20bb 8529 GCPRO1 (file);
333b20bb 8530
63cec32f 8531 if (STRINGP (specified_file))
333b20bb 8532 {
63cec32f
GM		 8533 file = x_find_image_file (specified_file);
8534 if (!STRINGP (file))
8535 {
8536 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8537 UNGCPRO;
8538 return 0;
8539 }
333b20bb 8540
5be6c3b0 8541 contents = slurp_file (XSTRING (file)->data, &size);
63cec32f
GM		 8542 if (contents == NULL)
8543 {
8544 image_error ("Error reading `%s'", file, Qnil);
8545 UNGCPRO;
8546 return 0;
8547 }
8548
8549 p = contents;
8550 end = contents + size;
8551 }
8552 else
333b20bb 8553 {
63cec32f
GM		 8554 Lisp_Object data;
8555 data = image_spec_value (img->spec, QCdata, NULL);
8556 p = XSTRING (data)->data;
8557 end = p + STRING_BYTES (XSTRING (data));
333b20bb
GM		 8558 }
8559
63cec32f
GM		 8560 /* Check magic number. */
8561 if (end - p < 2 || *p++ != 'P')
333b20bb 8562 {
45158a91 8563 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f
GM		 8564 error:
8565 xfree (contents);
333b20bb
GM		 8566 UNGCPRO;
8567 return 0;
8568 }
8569
63cec32f 8570 switch (*p++)
333b20bb
GM		 8571 {
8572 case '1':
8573 raw_p = 0, type = PBM_MONO;
8574 break;
8575
8576 case '2':
8577 raw_p = 0, type = PBM_GRAY;
8578 break;
8579
8580 case '3':
8581 raw_p = 0, type = PBM_COLOR;
8582 break;
8583
8584 case '4':
8585 raw_p = 1, type = PBM_MONO;
8586 break;
8587
8588 case '5':
8589 raw_p = 1, type = PBM_GRAY;
8590 break;
8591
8592 case '6':
8593 raw_p = 1, type = PBM_COLOR;
8594 break;
8595
8596 default:
45158a91 8597 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f 8598 goto error;
333b20bb
GM		 8599 }
8600
8601 /* Read width, height, maximum color-component. Characters
8602 starting with `#' up to the end of a line are ignored. */
63cec32f
GM		 8603 width = pbm_scan_number (&p, end);
8604 height = pbm_scan_number (&p, end);
333b20bb
GM		 8605
8606 if (type != PBM_MONO)
8607 {
63cec32f 8608 max_color_idx = pbm_scan_number (&p, end);
333b20bb
GM		 8609 if (raw_p && max_color_idx > 255)
8610 max_color_idx = 255;
8611 }
8612
63cec32f
GM		 8613 if (width < 0
8614 || height < 0
333b20bb 8615 || (type != PBM_MONO && max_color_idx < 0))
63cec32f 8616 goto error;
333b20bb 8617
45158a91 8618 if (!x_create_x_image_and_pixmap (f, width, height, 0,
333b20bb 8619 &ximg, &img->pixmap))
28c7826c 8620 goto error;
333b20bb
GM		 8621
8622 /* Initialize the color hash table. */
8623 init_color_table ();
8624
8625 if (type == PBM_MONO)
8626 {
8627 int c = 0, g;
be0b1fac
GM		 8628 struct image_keyword fmt[PBM_LAST];
8629 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
8630 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
8631
8632 /* Parse the image specification. */
8633 bcopy (pbm_format, fmt, sizeof fmt);
8634 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
8635
8636 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM		 8637 if (fmt[PBM_FOREGROUND].count
8638 && STRINGP (fmt[PBM_FOREGROUND].value))
be0b1fac 8639 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
6f1be3b9
GM		 8640 if (fmt[PBM_BACKGROUND].count
8641 && STRINGP (fmt[PBM_BACKGROUND].value))
f20a3b7a
MB		 8642 {
8643 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
8644 img->background = bg;
8645 img->background_valid = 1;
8646 }
333b20bb
GM		 8647
8648 for (y = 0; y < height; ++y)
8649 for (x = 0; x < width; ++x)
8650 {
8651 if (raw_p)
8652 {
8653 if ((x & 7) == 0)
63cec32f 8654 c = *p++;
333b20bb
GM		 8655 g = c & 0x80;
8656 c <<= 1;
8657 }
8658 else
63cec32f 8659 g = pbm_scan_number (&p, end);
333b20bb 8660
be0b1fac 8661 XPutPixel (ximg, x, y, g ? fg : bg);
333b20bb
GM		 8662 }
8663 }
8664 else
8665 {
8666 for (y = 0; y < height; ++y)
8667 for (x = 0; x < width; ++x)
8668 {
8669 int r, g, b;
8670
8671 if (type == PBM_GRAY)
63cec32f 8672 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
333b20bb
GM		 8673 else if (raw_p)
8674 {
63cec32f
GM		 8675 r = *p++;
8676 g = *p++;
8677 b = *p++;
333b20bb
GM		 8678 }
8679 else
8680 {
63cec32f
GM		 8681 r = pbm_scan_number (&p, end);
8682 g = pbm_scan_number (&p, end);
8683 b = pbm_scan_number (&p, end);
333b20bb
GM		 8684 }
8685
8686 if (r < 0 || g < 0 || b < 0)
8687 {
333b20bb
GM		 8688 xfree (ximg->data);
8689 ximg->data = NULL;
8690 XDestroyImage (ximg);
45158a91
GM		 8691 image_error ("Invalid pixel value in image `%s'",
8692 img->spec, Qnil);
63cec32f 8693 goto error;
333b20bb
GM		 8694 }
8695
8696 /* RGB values are now in the range 0..max_color_idx.
8697 Scale this to the range 0..0xffff supported by X. */
8698 r = (double) r * 65535 / max_color_idx;
8699 g = (double) g * 65535 / max_color_idx;
8700 b = (double) b * 65535 / max_color_idx;
8701 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8702 }
8703 }
8704
333b20bb
GM		 8705 /* Store in IMG->colors the colors allocated for the image, and
8706 free the color table. */
8707 img->colors = colors_in_color_table (&img->ncolors);
8708 free_color_table ();
f20a3b7a
MB		 8709
8710 /* Maybe fill in the background field while we have ximg handy. */
8711 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8712 IMAGE_BACKGROUND (img, f, ximg);
333b20bb
GM		 8713
8714 /* Put the image into a pixmap. */
8715 x_put_x_image (f, ximg, img->pixmap, width, height);
8716 x_destroy_x_image (ximg);
333b20bb
GM		 8717
8718 img->width = width;
8719 img->height = height;
8720
8721 UNGCPRO;
63cec32f 8722 xfree (contents);
333b20bb
GM		 8723 return 1;
8724}
8725
8726
8727\f
8728/***********************************************************************
8729 PNG
8730 ***********************************************************************/
8731
8732#if HAVE_PNG
8733
8734#include <png.h>
8735
8736/* Function prototypes. */
8737
8738static int png_image_p P_ ((Lisp_Object object));
8739static int png_load P_ ((struct frame *f, struct image *img));
8740
8741/* The symbol `png' identifying images of this type. */
8742
8743Lisp_Object Qpng;
8744
8745/* Indices of image specification fields in png_format, below. */
8746
8747enum png_keyword_index
8748{
8749 PNG_TYPE,
63448a4d 8750 PNG_DATA,
333b20bb
GM		 8751 PNG_FILE,
8752 PNG_ASCENT,
8753 PNG_MARGIN,
8754 PNG_RELIEF,
8755 PNG_ALGORITHM,
8756 PNG_HEURISTIC_MASK,
4a8e312c 8757 PNG_MASK,
f20a3b7a 8758 PNG_BACKGROUND,
333b20bb
GM		 8759 PNG_LAST
8760};
8761
8762/* Vector of image_keyword structures describing the format
8763 of valid user-defined image specifications. */
8764
8765static struct image_keyword png_format[PNG_LAST] =
8766{
8767 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 8768 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 8769 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8770 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8771 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8772 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8773 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 8774 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f2f0a644 8775 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a 8776 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 8777};
8778
06482119 8779/* Structure describing the image type `png'. */
333b20bb
GM		 8780
8781static struct image_type png_type =
8782{
8783 &Qpng,
8784 png_image_p,
8785 png_load,
8786 x_clear_image,
8787 NULL
8788};
8789
8790
8791/* Return non-zero if OBJECT is a valid PNG image specification. */
8792
8793static int
8794png_image_p (object)
8795 Lisp_Object object;
8796{
8797 struct image_keyword fmt[PNG_LAST];
8798 bcopy (png_format, fmt, sizeof fmt);
8799
7c7ff7f5 8800 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
333b20bb 8801 return 0;
63448a4d 8802
63cec32f
GM		 8803 /* Must specify either the :data or :file keyword. */
8804 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
333b20bb
GM		 8805}
8806
8807
8808/* Error and warning handlers installed when the PNG library
8809 is initialized. */
8810
8811static void
8812my_png_error (png_ptr, msg)
8813 png_struct *png_ptr;
8814 char *msg;
8815{
8816 xassert (png_ptr != NULL);
8817 image_error ("PNG error: %s", build_string (msg), Qnil);
8818 longjmp (png_ptr->jmpbuf, 1);
8819}
8820
8821
8822static void
8823my_png_warning (png_ptr, msg)
8824 png_struct *png_ptr;
8825 char *msg;
8826{
8827 xassert (png_ptr != NULL);
8828 image_error ("PNG warning: %s", build_string (msg), Qnil);
8829}
8830
5ad6a5fb
GM		 8831/* Memory source for PNG decoding. */
8832
63448a4d
WP		 8833struct png_memory_storage
8834{
5ad6a5fb
GM		 8835 unsigned char *bytes; /* The data */
8836 size_t len; /* How big is it? */
8837 int index; /* Where are we? */
63448a4d
WP		 8838};
8839
5ad6a5fb
GM		 8840
8841/* Function set as reader function when reading PNG image from memory.
8842 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8843 bytes from the input to DATA. */
8844
63448a4d 8845static void
5ad6a5fb
GM		 8846png_read_from_memory (png_ptr, data, length)
8847 png_structp png_ptr;
8848 png_bytep data;
8849 png_size_t length;
63448a4d 8850{
5ad6a5fb
GM		 8851 struct png_memory_storage *tbr
8852 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
63448a4d 8853
5ad6a5fb
GM		 8854 if (length > tbr->len - tbr->index)
8855 png_error (png_ptr, "Read error");
8856
8857 bcopy (tbr->bytes + tbr->index, data, length);
8858 tbr->index = tbr->index + length;
63448a4d 8859}
333b20bb
GM		 8860
8861/* Load PNG image IMG for use on frame F. Value is non-zero if
8862 successful. */
8863
8864static int
8865png_load (f, img)
8866 struct frame *f;
8867 struct image *img;
8868{
8869 Lisp_Object file, specified_file;
63448a4d 8870 Lisp_Object specified_data;
b6d7acec 8871 int x, y, i;
333b20bb
GM		 8872 XImage *ximg, *mask_img = NULL;
8873 struct gcpro gcpro1;
8874 png_struct *png_ptr = NULL;
8875 png_info *info_ptr = NULL, *end_info = NULL;
8ec8a5ec 8876 FILE *volatile fp = NULL;
333b20bb 8877 png_byte sig[8];
8ec8a5ec
GM		 8878 png_byte * volatile pixels = NULL;
8879 png_byte ** volatile rows = NULL;
333b20bb
GM		 8880 png_uint_32 width, height;
8881 int bit_depth, color_type, interlace_type;
8882 png_byte channels;
8883 png_uint_32 row_bytes;
8884 int transparent_p;
8885 char *gamma_str;
8886 double screen_gamma, image_gamma;
8887 int intent;
63448a4d 8888 struct png_memory_storage tbr; /* Data to be read */
333b20bb
GM		 8889
8890 /* Find out what file to load. */
8891 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 8892 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 8893 file = Qnil;
8894 GCPRO1 (file);
333b20bb 8895
63448a4d 8896 if (NILP (specified_data))
5ad6a5fb
GM		 8897 {
8898 file = x_find_image_file (specified_file);
8899 if (!STRINGP (file))
63448a4d 8900 {
45158a91 8901 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM		 8902 UNGCPRO;
8903 return 0;
8904 }
333b20bb 8905
5ad6a5fb
GM		 8906 /* Open the image file. */
8907 fp = fopen (XSTRING (file)->data, "rb");
8908 if (!fp)
8909 {
45158a91 8910 image_error ("Cannot open image file `%s'", file, Qnil);
5ad6a5fb
GM		 8911 UNGCPRO;
8912 fclose (fp);
8913 return 0;
8914 }
63448a4d 8915
5ad6a5fb
GM		 8916 /* Check PNG signature. */
8917 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
8918 || !png_check_sig (sig, sizeof sig))
8919 {
45158a91 8920 image_error ("Not a PNG file: `%s'", file, Qnil);
5ad6a5fb
GM		 8921 UNGCPRO;
8922 fclose (fp);
8923 return 0;
63448a4d 8924 }
5ad6a5fb 8925 }
63448a4d 8926 else
5ad6a5fb
GM		 8927 {
8928 /* Read from memory. */
8929 tbr.bytes = XSTRING (specified_data)->data;
8930 tbr.len = STRING_BYTES (XSTRING (specified_data));
8931 tbr.index = 0;
63448a4d 8932
5ad6a5fb
GM		 8933 /* Check PNG signature. */
8934 if (tbr.len < sizeof sig
8935 || !png_check_sig (tbr.bytes, sizeof sig))
8936 {
45158a91 8937 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
5ad6a5fb
GM		 8938 UNGCPRO;
8939 return 0;
63448a4d 8940 }
333b20bb 8941
5ad6a5fb
GM		 8942 /* Need to skip past the signature. */
8943 tbr.bytes += sizeof (sig);
8944 }
8945
333b20bb
GM		 8946 /* Initialize read and info structs for PNG lib. */
8947 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
8948 my_png_error, my_png_warning);
8949 if (!png_ptr)
8950 {
63448a4d 8951 if (fp) fclose (fp);
333b20bb
GM		 8952 UNGCPRO;
8953 return 0;
8954 }
8955
8956 info_ptr = png_create_info_struct (png_ptr);
8957 if (!info_ptr)
8958 {
8959 png_destroy_read_struct (&png_ptr, NULL, NULL);
63448a4d 8960 if (fp) fclose (fp);
333b20bb
GM		 8961 UNGCPRO;
8962 return 0;
8963 }
8964
8965 end_info = png_create_info_struct (png_ptr);
8966 if (!end_info)
8967 {
8968 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
63448a4d 8969 if (fp) fclose (fp);
333b20bb
GM		 8970 UNGCPRO;
8971 return 0;
8972 }
8973
8974 /* Set error jump-back. We come back here when the PNG library
8975 detects an error. */
8976 if (setjmp (png_ptr->jmpbuf))
8977 {
8978 error:
8979 if (png_ptr)
8980 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8981 xfree (pixels);
8982 xfree (rows);
63448a4d 8983 if (fp) fclose (fp);
333b20bb
GM		 8984 UNGCPRO;
8985 return 0;
8986 }
8987
8988 /* Read image info. */
63448a4d 8989 if (!NILP (specified_data))
5ad6a5fb 8990 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
63448a4d 8991 else
5ad6a5fb 8992 png_init_io (png_ptr, fp);
63448a4d 8993
333b20bb
GM		 8994 png_set_sig_bytes (png_ptr, sizeof sig);
8995 png_read_info (png_ptr, info_ptr);
8996 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8997 &interlace_type, NULL, NULL);
8998
8999 /* If image contains simply transparency data, we prefer to
9000 construct a clipping mask. */
9001 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
9002 transparent_p = 1;
9003 else
9004 transparent_p = 0;
9005
9006 /* This function is easier to write if we only have to handle
9007 one data format: RGB or RGBA with 8 bits per channel. Let's
9008 transform other formats into that format. */
9009
9010 /* Strip more than 8 bits per channel. */
9011 if (bit_depth == 16)
9012 png_set_strip_16 (png_ptr);
9013
9014 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9015 if available. */
9016 png_set_expand (png_ptr);
9017
9018 /* Convert grayscale images to RGB. */
9019 if (color_type == PNG_COLOR_TYPE_GRAY
9020 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
9021 png_set_gray_to_rgb (png_ptr);
9022
9023 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
9024 gamma_str = getenv ("SCREEN_GAMMA");
9025 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
9026
9027 /* Tell the PNG lib to handle gamma correction for us. */
9028
6c1aa34d 9029#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
333b20bb
GM		 9030 if (png_get_sRGB (png_ptr, info_ptr, &intent))
9031 /* There is a special chunk in the image specifying the gamma. */
9032 png_set_sRGB (png_ptr, info_ptr, intent);
6c1aa34d
GM		 9033 else
9034#endif
9035 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
333b20bb
GM		 9036 /* Image contains gamma information. */
9037 png_set_gamma (png_ptr, screen_gamma, image_gamma);
9038 else
9039 /* Use a default of 0.5 for the image gamma. */
9040 png_set_gamma (png_ptr, screen_gamma, 0.5);
9041
9042 /* Handle alpha channel by combining the image with a background
9043 color. Do this only if a real alpha channel is supplied. For
9044 simple transparency, we prefer a clipping mask. */
9045 if (!transparent_p)
9046 {
f20a3b7a
MB		 9047 png_color_16 *image_bg;
9048 Lisp_Object specified_bg
9049 = image_spec_value (img->spec, QCbackground, NULL);
9050
f2f0a644 9051 if (STRINGP (specified_bg))
f20a3b7a
MB		 9052 /* The user specified `:background', use that. */
9053 {
9054 XColor color;
f2f0a644 9055 if (x_defined_color (f, XSTRING (specified_bg)->data, &color, 0))
f20a3b7a
MB		 9056 {
9057 png_color_16 user_bg;
9058
9059 bzero (&user_bg, sizeof user_bg);
9060 user_bg.red = color.red;
9061 user_bg.green = color.green;
9062 user_bg.blue = color.blue;
333b20bb 9063
f20a3b7a
MB		 9064 png_set_background (png_ptr, &user_bg,
9065 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
9066 }
9067 }
9068 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
333b20bb
GM		 9069 /* Image contains a background color with which to
9070 combine the image. */
f20a3b7a 9071 png_set_background (png_ptr, image_bg,
333b20bb
GM		 9072 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
9073 else
9074 {
9075 /* Image does not contain a background color with which
9076 to combine the image data via an alpha channel. Use
9077 the frame's background instead. */
9078 XColor color;
9079 Colormap cmap;
9080 png_color_16 frame_background;
9081
9b2956e2 9082 cmap = FRAME_X_COLORMAP (f);
333b20bb 9083 color.pixel = FRAME_BACKGROUND_PIXEL (f);
a31fedb7 9084 x_query_color (f, &color);
333b20bb
GM		 9085
9086 bzero (&frame_background, sizeof frame_background);
9087 frame_background.red = color.red;
9088 frame_background.green = color.green;
9089 frame_background.blue = color.blue;
9090
9091 png_set_background (png_ptr, &frame_background,
9092 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
9093 }
9094 }
9095
9096 /* Update info structure. */
9097 png_read_update_info (png_ptr, info_ptr);
9098
9099 /* Get number of channels. Valid values are 1 for grayscale images
9100 and images with a palette, 2 for grayscale images with transparency
9101 information (alpha channel), 3 for RGB images, and 4 for RGB
9102 images with alpha channel, i.e. RGBA. If conversions above were
9103 sufficient we should only have 3 or 4 channels here. */
9104 channels = png_get_channels (png_ptr, info_ptr);
9105 xassert (channels == 3 || channels == 4);
9106
9107 /* Number of bytes needed for one row of the image. */
9108 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
9109
9110 /* Allocate memory for the image. */
9111 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
9112 rows = (png_byte **) xmalloc (height * sizeof *rows);
9113 for (i = 0; i < height; ++i)
9114 rows[i] = pixels + i * row_bytes;
9115
9116 /* Read the entire image. */
9117 png_read_image (png_ptr, rows);
9118 png_read_end (png_ptr, info_ptr);
5ad6a5fb
GM		 9119 if (fp)
9120 {
9121 fclose (fp);
9122 fp = NULL;
9123 }
333b20bb 9124
333b20bb 9125 /* Create the X image and pixmap. */
45158a91 9126 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
333b20bb 9127 &img->pixmap))
28c7826c 9128 goto error;
333b20bb
GM		 9129
9130 /* Create an image and pixmap serving as mask if the PNG image
9131 contains an alpha channel. */
9132 if (channels == 4
9133 && !transparent_p
45158a91 9134 && !x_create_x_image_and_pixmap (f, width, height, 1,
333b20bb
GM		 9135 &mask_img, &img->mask))
9136 {
9137 x_destroy_x_image (ximg);
9138 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 9139 img->pixmap = None;
333b20bb
GM		 9140 goto error;
9141 }
9142
9143 /* Fill the X image and mask from PNG data. */
9144 init_color_table ();
9145
9146 for (y = 0; y < height; ++y)
9147 {
9148 png_byte *p = rows[y];
9149
9150 for (x = 0; x < width; ++x)
9151 {
9152 unsigned r, g, b;
9153
9154 r = *p++ << 8;
9155 g = *p++ << 8;
9156 b = *p++ << 8;
9157 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
9158
9159 /* An alpha channel, aka mask channel, associates variable
9160 transparency with an image. Where other image formats
9161 support binary transparency---fully transparent or fully
9162 opaque---PNG allows up to 254 levels of partial transparency.
9163 The PNG library implements partial transparency by combining
9164 the image with a specified background color.
9165
9166 I'm not sure how to handle this here nicely: because the
9167 background on which the image is displayed may change, for
9168 real alpha channel support, it would be necessary to create
9169 a new image for each possible background.
9170
9171 What I'm doing now is that a mask is created if we have
9172 boolean transparency information. Otherwise I'm using
9173 the frame's background color to combine the image with. */
9174
9175 if (channels == 4)
9176 {
9177 if (mask_img)
9178 XPutPixel (mask_img, x, y, *p > 0);
9179 ++p;
9180 }
9181 }
9182 }
9183
f20a3b7a
MB		 9184 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9185 /* Set IMG's background color from the PNG image, unless the user
9186 overrode it. */
9187 {
9188 png_color_16 *bg;
9189 if (png_get_bKGD (png_ptr, info_ptr, &bg))
9190 {
f2f0a644 9191 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
f20a3b7a
MB		 9192 img->background_valid = 1;
9193 }
9194 }
9195
333b20bb
GM		 9196 /* Remember colors allocated for this image. */
9197 img->colors = colors_in_color_table (&img->ncolors);
9198 free_color_table ();
9199
9200 /* Clean up. */
9201 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
9202 xfree (rows);
9203 xfree (pixels);
9204
9205 img->width = width;
9206 img->height = height;
9207
f20a3b7a
MB		 9208 /* Maybe fill in the background field while we have ximg handy. */
9209 IMAGE_BACKGROUND (img, f, ximg);
9210
333b20bb
GM		 9211 /* Put the image into the pixmap, then free the X image and its buffer. */
9212 x_put_x_image (f, ximg, img->pixmap, width, height);
9213 x_destroy_x_image (ximg);
9214
9215 /* Same for the mask. */
9216 if (mask_img)
9217 {
f20a3b7a
MB		 9218 /* Fill in the background_transparent field while we have the mask
9219 handy. */
9220 image_background_transparent (img, f, mask_img);
9221
333b20bb
GM		 9222 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
9223 x_destroy_x_image (mask_img);
9224 }
9225
333b20bb
GM		 9226 UNGCPRO;
9227 return 1;
9228}
9229
9230#endif /* HAVE_PNG != 0 */
9231
9232
9233\f
9234/***********************************************************************
9235 JPEG
9236 ***********************************************************************/
9237
9238#if HAVE_JPEG
9239
ba06aba4
GM		 9240/* Work around a warning about HAVE_STDLIB_H being redefined in
9241 jconfig.h. */
9242#ifdef HAVE_STDLIB_H
9243#define HAVE_STDLIB_H_1
9244#undef HAVE_STDLIB_H
9245#endif /* HAVE_STLIB_H */
9246
333b20bb
GM		 9247#include <jpeglib.h>
9248#include <jerror.h>
9249#include <setjmp.h>
9250
ba06aba4
GM		 9251#ifdef HAVE_STLIB_H_1
9252#define HAVE_STDLIB_H 1
9253#endif
9254
333b20bb
GM		 9255static int jpeg_image_p P_ ((Lisp_Object object));
9256static int jpeg_load P_ ((struct frame *f, struct image *img));
9257
9258/* The symbol `jpeg' identifying images of this type. */
9259
9260Lisp_Object Qjpeg;
9261
9262/* Indices of image specification fields in gs_format, below. */
9263
9264enum jpeg_keyword_index
9265{
9266 JPEG_TYPE,
8e39770a 9267 JPEG_DATA,
333b20bb
GM		 9268 JPEG_FILE,
9269 JPEG_ASCENT,
9270 JPEG_MARGIN,
9271 JPEG_RELIEF,
9272 JPEG_ALGORITHM,
9273 JPEG_HEURISTIC_MASK,
4a8e312c 9274 JPEG_MASK,
f20a3b7a 9275 JPEG_BACKGROUND,
333b20bb
GM		 9276 JPEG_LAST
9277};
9278
9279/* Vector of image_keyword structures describing the format
9280 of valid user-defined image specifications. */
9281
9282static struct image_keyword jpeg_format[JPEG_LAST] =
9283{
9284 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9285 {":data", IMAGE_STRING_VALUE, 0},
8e39770a 9286 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9287 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9288 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9289 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9290 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 9291 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 9292 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9293 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 9294};
9295
9296/* Structure describing the image type `jpeg'. */
9297
9298static struct image_type jpeg_type =
9299{
9300 &Qjpeg,
9301 jpeg_image_p,
9302 jpeg_load,
9303 x_clear_image,
9304 NULL
9305};
9306
9307
9308/* Return non-zero if OBJECT is a valid JPEG image specification. */
9309
9310static int
9311jpeg_image_p (object)
9312 Lisp_Object object;
9313{
9314 struct image_keyword fmt[JPEG_LAST];
9315
9316 bcopy (jpeg_format, fmt, sizeof fmt);
9317
7c7ff7f5 9318 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
333b20bb 9319 return 0;
8e39770a 9320
63cec32f
GM		 9321 /* Must specify either the :data or :file keyword. */
9322 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
333b20bb
GM		 9323}
9324
8e39770a 9325
333b20bb
GM		 9326struct my_jpeg_error_mgr
9327{
9328 struct jpeg_error_mgr pub;
9329 jmp_buf setjmp_buffer;
9330};
9331
e3130015 9332
333b20bb
GM		 9333static void
9334my_error_exit (cinfo)
9335 j_common_ptr cinfo;
9336{
9337 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
9338 longjmp (mgr->setjmp_buffer, 1);
9339}
9340
e3130015 9341
8e39770a
GM		 9342/* Init source method for JPEG data source manager. Called by
9343 jpeg_read_header() before any data is actually read. See
9344 libjpeg.doc from the JPEG lib distribution. */
9345
9346static void
9347our_init_source (cinfo)
9348 j_decompress_ptr cinfo;
9349{
9350}
9351
9352
9353/* Fill input buffer method for JPEG data source manager. Called
9354 whenever more data is needed. We read the whole image in one step,
9355 so this only adds a fake end of input marker at the end. */
9356
9357static boolean
9358our_fill_input_buffer (cinfo)
9359 j_decompress_ptr cinfo;
9360{
9361 /* Insert a fake EOI marker. */
9362 struct jpeg_source_mgr *src = cinfo->src;
9363 static JOCTET buffer[2];
9364
9365 buffer[0] = (JOCTET) 0xFF;
9366 buffer[1] = (JOCTET) JPEG_EOI;
9367
9368 src->next_input_byte = buffer;
9369 src->bytes_in_buffer = 2;
9370 return TRUE;
9371}
9372
9373
9374/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9375 is the JPEG data source manager. */
9376
9377static void
9378our_skip_input_data (cinfo, num_bytes)
9379 j_decompress_ptr cinfo;
9380 long num_bytes;
9381{
9382 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
9383
9384 if (src)
9385 {
9386 if (num_bytes > src->bytes_in_buffer)
5ad6a5fb 9387 ERREXIT (cinfo, JERR_INPUT_EOF);
8e39770a
GM		 9388
9389 src->bytes_in_buffer -= num_bytes;
9390 src->next_input_byte += num_bytes;
9391 }
9392}
9393
9394
9395/* Method to terminate data source. Called by
9396 jpeg_finish_decompress() after all data has been processed. */
9397
9398static void
9399our_term_source (cinfo)
9400 j_decompress_ptr cinfo;
9401{
9402}
9403
9404
9405/* Set up the JPEG lib for reading an image from DATA which contains
9406 LEN bytes. CINFO is the decompression info structure created for
9407 reading the image. */
9408
9409static void
9410jpeg_memory_src (cinfo, data, len)
9411 j_decompress_ptr cinfo;
9412 JOCTET *data;
9413 unsigned int len;
9414{
9415 struct jpeg_source_mgr *src;
9416
9417 if (cinfo->src == NULL)
9418 {
9419 /* First time for this JPEG object? */
9420 cinfo->src = (struct jpeg_source_mgr *)
9421 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
9422 sizeof (struct jpeg_source_mgr));
9423 src = (struct jpeg_source_mgr *) cinfo->src;
9424 src->next_input_byte = data;
9425 }
9426
9427 src = (struct jpeg_source_mgr *) cinfo->src;
9428 src->init_source = our_init_source;
9429 src->fill_input_buffer = our_fill_input_buffer;
9430 src->skip_input_data = our_skip_input_data;
9431 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
9432 src->term_source = our_term_source;
9433 src->bytes_in_buffer = len;
9434 src->next_input_byte = data;
9435}
9436
5ad6a5fb 9437
333b20bb
GM		 9438/* Load image IMG for use on frame F. Patterned after example.c
9439 from the JPEG lib. */
9440
9441static int
9442jpeg_load (f, img)
9443 struct frame *f;
9444 struct image *img;
9445{
9446 struct jpeg_decompress_struct cinfo;
9447 struct my_jpeg_error_mgr mgr;
9448 Lisp_Object file, specified_file;
8e39770a 9449 Lisp_Object specified_data;
8ec8a5ec 9450 FILE * volatile fp = NULL;
333b20bb
GM		 9451 JSAMPARRAY buffer;
9452 int row_stride, x, y;
9453 XImage *ximg = NULL;
b6d7acec 9454 int rc;
333b20bb
GM		 9455 unsigned long *colors;
9456 int width, height;
9457 struct gcpro gcpro1;
9458
9459 /* Open the JPEG file. */
9460 specified_file = image_spec_value (img->spec, QCfile, NULL);
8e39770a 9461 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9462 file = Qnil;
9463 GCPRO1 (file);
8e39770a 9464
8e39770a 9465 if (NILP (specified_data))
333b20bb 9466 {
8e39770a 9467 file = x_find_image_file (specified_file);
8e39770a
GM		 9468 if (!STRINGP (file))
9469 {
45158a91 9470 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8e39770a
GM		 9471 UNGCPRO;
9472 return 0;
9473 }
333b20bb 9474
8e39770a
GM		 9475 fp = fopen (XSTRING (file)->data, "r");
9476 if (fp == NULL)
9477 {
9478 image_error ("Cannot open `%s'", file, Qnil);
9479 UNGCPRO;
9480 return 0;
9481 }
333b20bb
GM		 9482 }
9483
5ad6a5fb
GM		 9484 /* Customize libjpeg's error handling to call my_error_exit when an
9485 error is detected. This function will perform a longjmp. */
333b20bb 9486 cinfo.err = jpeg_std_error (&mgr.pub);
14358466 9487 mgr.pub.error_exit = my_error_exit;
333b20bb
GM		 9488
9489 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
9490 {
5ad6a5fb
GM		 9491 if (rc == 1)
9492 {
9493 /* Called from my_error_exit. Display a JPEG error. */
9494 char buffer[JMSG_LENGTH_MAX];
9495 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
45158a91 9496 image_error ("Error reading JPEG image `%s': %s", img->spec,
5ad6a5fb
GM		 9497 build_string (buffer));
9498 }
333b20bb
GM		 9499
9500 /* Close the input file and destroy the JPEG object. */
5ad6a5fb 9501 if (fp)
8ec8a5ec 9502 fclose ((FILE *) fp);
333b20bb
GM		 9503 jpeg_destroy_decompress (&cinfo);
9504
5ad6a5fb
GM		 9505 /* If we already have an XImage, free that. */
9506 x_destroy_x_image (ximg);
333b20bb 9507
5ad6a5fb
GM		 9508 /* Free pixmap and colors. */
9509 x_clear_image (f, img);
333b20bb 9510
5ad6a5fb
GM		 9511 UNGCPRO;
9512 return 0;
333b20bb
GM		 9513 }
9514
9515 /* Create the JPEG decompression object. Let it read from fp.
63448a4d 9516 Read the JPEG image header. */
333b20bb 9517 jpeg_create_decompress (&cinfo);
8e39770a
GM		 9518
9519 if (NILP (specified_data))
8ec8a5ec 9520 jpeg_stdio_src (&cinfo, (FILE *) fp);
8e39770a
GM		 9521 else
9522 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
9523 STRING_BYTES (XSTRING (specified_data)));
63448a4d 9524
333b20bb
GM		 9525 jpeg_read_header (&cinfo, TRUE);
9526
9527 /* Customize decompression so that color quantization will be used.
63448a4d 9528 Start decompression. */
333b20bb
GM		 9529 cinfo.quantize_colors = TRUE;
9530 jpeg_start_decompress (&cinfo);
9531 width = img->width = cinfo.output_width;
9532 height = img->height = cinfo.output_height;
9533
333b20bb 9534 /* Create X image and pixmap. */
45158a91 9535 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
28c7826c 9536 longjmp (mgr.setjmp_buffer, 2);
333b20bb
GM		 9537
9538 /* Allocate colors. When color quantization is used,
5ad6a5fb
GM		 9539 cinfo.actual_number_of_colors has been set with the number of
9540 colors generated, and cinfo.colormap is a two-dimensional array
9541 of color indices in the range 0..cinfo.actual_number_of_colors.
9542 No more than 255 colors will be generated. */
333b20bb 9543 {
5ad6a5fb
GM		 9544 int i, ir, ig, ib;
9545
9546 if (cinfo.out_color_components > 2)
9547 ir = 0, ig = 1, ib = 2;
9548 else if (cinfo.out_color_components > 1)
9549 ir = 0, ig = 1, ib = 0;
9550 else
9551 ir = 0, ig = 0, ib = 0;
9552
9553 /* Use the color table mechanism because it handles colors that
9554 cannot be allocated nicely. Such colors will be replaced with
9555 a default color, and we don't have to care about which colors
9556 can be freed safely, and which can't. */
9557 init_color_table ();
9558 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
9559 * sizeof *colors);
333b20bb 9560
5ad6a5fb
GM		 9561 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
9562 {
9563 /* Multiply RGB values with 255 because X expects RGB values
9564 in the range 0..0xffff. */
9565 int r = cinfo.colormap[ir][i] << 8;
9566 int g = cinfo.colormap[ig][i] << 8;
9567 int b = cinfo.colormap[ib][i] << 8;
9568 colors[i] = lookup_rgb_color (f, r, g, b);
9569 }
333b20bb 9570
5ad6a5fb
GM		 9571 /* Remember those colors actually allocated. */
9572 img->colors = colors_in_color_table (&img->ncolors);
9573 free_color_table ();
333b20bb
GM		 9574 }
9575
9576 /* Read pixels. */
9577 row_stride = width * cinfo.output_components;
9578 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
5ad6a5fb 9579 row_stride, 1);
333b20bb
GM		 9580 for (y = 0; y < height; ++y)
9581 {
5ad6a5fb
GM		 9582 jpeg_read_scanlines (&cinfo, buffer, 1);
9583 for (x = 0; x < cinfo.output_width; ++x)
9584 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
333b20bb
GM		 9585 }
9586
9587 /* Clean up. */
9588 jpeg_finish_decompress (&cinfo);
9589 jpeg_destroy_decompress (&cinfo);
5ad6a5fb 9590 if (fp)
8ec8a5ec 9591 fclose ((FILE *) fp);
f20a3b7a
MB		 9592
9593 /* Maybe fill in the background field while we have ximg handy. */
9594 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9595 IMAGE_BACKGROUND (img, f, ximg);
333b20bb
GM		 9596
9597 /* Put the image into the pixmap. */
9598 x_put_x_image (f, ximg, img->pixmap, width, height);
9599 x_destroy_x_image (ximg);
333b20bb
GM		 9600 UNGCPRO;
9601 return 1;
9602}
9603
9604#endif /* HAVE_JPEG */
9605
9606
9607\f
9608/***********************************************************************
9609 TIFF
9610 ***********************************************************************/
9611
9612#if HAVE_TIFF
9613
cf4790ad 9614#include <tiffio.h>
333b20bb
GM		 9615
9616static int tiff_image_p P_ ((Lisp_Object object));
9617static int tiff_load P_ ((struct frame *f, struct image *img));
9618
9619/* The symbol `tiff' identifying images of this type. */
9620
9621Lisp_Object Qtiff;
9622
9623/* Indices of image specification fields in tiff_format, below. */
9624
9625enum tiff_keyword_index
9626{
9627 TIFF_TYPE,
63448a4d 9628 TIFF_DATA,
333b20bb
GM		 9629 TIFF_FILE,
9630 TIFF_ASCENT,
9631 TIFF_MARGIN,
9632 TIFF_RELIEF,
9633 TIFF_ALGORITHM,
9634 TIFF_HEURISTIC_MASK,
4a8e312c 9635 TIFF_MASK,
f20a3b7a 9636 TIFF_BACKGROUND,
333b20bb
GM		 9637 TIFF_LAST
9638};
9639
9640/* Vector of image_keyword structures describing the format
9641 of valid user-defined image specifications. */
9642
9643static struct image_keyword tiff_format[TIFF_LAST] =
9644{
9645 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9646 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 9647 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9648 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9649 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9650 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9651 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 9652 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 9653 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9654 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 9655};
9656
9657/* Structure describing the image type `tiff'. */
9658
9659static struct image_type tiff_type =
9660{
9661 &Qtiff,
9662 tiff_image_p,
9663 tiff_load,
9664 x_clear_image,
9665 NULL
9666};
9667
9668
9669/* Return non-zero if OBJECT is a valid TIFF image specification. */
9670
9671static int
9672tiff_image_p (object)
9673 Lisp_Object object;
9674{
9675 struct image_keyword fmt[TIFF_LAST];
9676 bcopy (tiff_format, fmt, sizeof fmt);
9677
7c7ff7f5 9678 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
333b20bb 9679 return 0;
5ad6a5fb 9680
63cec32f
GM		 9681 /* Must specify either the :data or :file keyword. */
9682 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
333b20bb
GM		 9683}
9684
5ad6a5fb
GM		 9685
9686/* Reading from a memory buffer for TIFF images Based on the PNG
9687 memory source, but we have to provide a lot of extra functions.
9688 Blah.
63448a4d
WP		 9689
9690 We really only need to implement read and seek, but I am not
9691 convinced that the TIFF library is smart enough not to destroy
9692 itself if we only hand it the function pointers we need to
5ad6a5fb
GM		 9693 override. */
9694
9695typedef struct
9696{
63448a4d
WP		 9697 unsigned char *bytes;
9698 size_t len;
9699 int index;
5ad6a5fb
GM		 9700}
9701tiff_memory_source;
63448a4d 9702
e3130015 9703
5ad6a5fb
GM		 9704static size_t
9705tiff_read_from_memory (data, buf, size)
9706 thandle_t data;
9707 tdata_t buf;
9708 tsize_t size;
63448a4d 9709{
5ad6a5fb 9710 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP		 9711
9712 if (size > src->len - src->index)
5ad6a5fb
GM		 9713 return (size_t) -1;
9714 bcopy (src->bytes + src->index, buf, size);
63448a4d
WP		 9715 src->index += size;
9716 return size;
9717}
9718
e3130015 9719
5ad6a5fb
GM		 9720static size_t
9721tiff_write_from_memory (data, buf, size)
9722 thandle_t data;
9723 tdata_t buf;
9724 tsize_t size;
63448a4d
WP		 9725{
9726 return (size_t) -1;
9727}
9728
e3130015 9729
5ad6a5fb
GM		 9730static toff_t
9731tiff_seek_in_memory (data, off, whence)
9732 thandle_t data;
9733 toff_t off;
9734 int whence;
63448a4d 9735{
5ad6a5fb 9736 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP		 9737 int idx;
9738
9739 switch (whence)
5ad6a5fb
GM		 9740 {
9741 case SEEK_SET: /* Go from beginning of source. */
9742 idx = off;
9743 break;
9744
9745 case SEEK_END: /* Go from end of source. */
9746 idx = src->len + off;
9747 break;
9748
9749 case SEEK_CUR: /* Go from current position. */
9750 idx = src->index + off;
9751 break;
9752
9753 default: /* Invalid `whence'. */
9754 return -1;
9755 }
9756
9757 if (idx > src->len || idx < 0)
9758 return -1;
9759
63448a4d
WP		 9760 src->index = idx;
9761 return src->index;
9762}
9763
e3130015 9764
5ad6a5fb
GM		 9765static int
9766tiff_close_memory (data)
9767 thandle_t data;
63448a4d
WP		 9768{
9769 /* NOOP */
5ad6a5fb 9770 return 0;
63448a4d
WP		 9771}
9772
e3130015 9773
5ad6a5fb
GM		 9774static int
9775tiff_mmap_memory (data, pbase, psize)
9776 thandle_t data;
9777 tdata_t *pbase;
9778 toff_t *psize;
63448a4d
WP		 9779{
9780 /* It is already _IN_ memory. */
5ad6a5fb 9781 return 0;
63448a4d
WP		 9782}
9783
e3130015 9784
5ad6a5fb
GM		 9785static void
9786tiff_unmap_memory (data, base, size)
9787 thandle_t data;
9788 tdata_t base;
9789 toff_t size;
63448a4d
WP		 9790{
9791 /* We don't need to do this. */
63448a4d
WP		 9792}
9793
e3130015 9794
5ad6a5fb
GM		 9795static toff_t
9796tiff_size_of_memory (data)
9797 thandle_t data;
63448a4d 9798{
5ad6a5fb 9799 return ((tiff_memory_source *) data)->len;
63448a4d 9800}
333b20bb 9801
e3130015 9802
c6892044
GM		 9803static void
9804tiff_error_handler (title, format, ap)
9805 const char *title, *format;
9806 va_list ap;
9807{
9808 char buf[512];
9809 int len;
9810
9811 len = sprintf (buf, "TIFF error: %s ", title);
9812 vsprintf (buf + len, format, ap);
9813 add_to_log (buf, Qnil, Qnil);
9814}
9815
9816
9817static void
9818tiff_warning_handler (title, format, ap)
9819 const char *title, *format;
9820 va_list ap;
9821{
9822 char buf[512];
9823 int len;
9824
9825 len = sprintf (buf, "TIFF warning: %s ", title);
9826 vsprintf (buf + len, format, ap);
9827 add_to_log (buf, Qnil, Qnil);
9828}
9829
9830
333b20bb
GM		 9831/* Load TIFF image IMG for use on frame F. Value is non-zero if
9832 successful. */
9833
9834static int
9835tiff_load (f, img)
9836 struct frame *f;
9837 struct image *img;
9838{
9839 Lisp_Object file, specified_file;
63448a4d 9840 Lisp_Object specified_data;
333b20bb
GM		 9841 TIFF *tiff;
9842 int width, height, x, y;
9843 uint32 *buf;
9844 int rc;
9845 XImage *ximg;
9846 struct gcpro gcpro1;
63448a4d 9847 tiff_memory_source memsrc;
333b20bb
GM		 9848
9849 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9850 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9851 file = Qnil;
9852 GCPRO1 (file);
63448a4d 9853
c6892044
GM		 9854 TIFFSetErrorHandler (tiff_error_handler);
9855 TIFFSetWarningHandler (tiff_warning_handler);
9856
63448a4d 9857 if (NILP (specified_data))
5ad6a5fb
GM		 9858 {
9859 /* Read from a file */
9860 file = x_find_image_file (specified_file);
9861 if (!STRINGP (file))
63448a4d 9862 {
45158a91 9863 image_error ("Cannot find image file `%s'", file, Qnil);
5ad6a5fb
GM		 9864 UNGCPRO;
9865 return 0;
9866 }
63448a4d 9867
5ad6a5fb
GM		 9868 /* Try to open the image file. */
9869 tiff = TIFFOpen (XSTRING (file)->data, "r");
9870 if (tiff == NULL)
9871 {
9872 image_error ("Cannot open `%s'", file, Qnil);
9873 UNGCPRO;
9874 return 0;
63448a4d 9875 }
5ad6a5fb 9876 }
63448a4d 9877 else
5ad6a5fb
GM		 9878 {
9879 /* Memory source! */
9880 memsrc.bytes = XSTRING (specified_data)->data;
9881 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9882 memsrc.index = 0;
9883
9884 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
9885 (TIFFReadWriteProc) tiff_read_from_memory,
9886 (TIFFReadWriteProc) tiff_write_from_memory,
9887 tiff_seek_in_memory,
9888 tiff_close_memory,
9889 tiff_size_of_memory,
9890 tiff_mmap_memory,
9891 tiff_unmap_memory);
9892
9893 if (!tiff)
63448a4d 9894 {
45158a91 9895 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
5ad6a5fb
GM		 9896 UNGCPRO;
9897 return 0;
63448a4d 9898 }
5ad6a5fb 9899 }
333b20bb
GM		 9900
9901 /* Get width and height of the image, and allocate a raster buffer
9902 of width x height 32-bit values. */
9903 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
9904 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
9905 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
9906
9907 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
9908 TIFFClose (tiff);
9909 if (!rc)
9910 {
45158a91 9911 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
333b20bb
GM		 9912 xfree (buf);
9913 UNGCPRO;
9914 return 0;
9915 }
9916
333b20bb 9917 /* Create the X image and pixmap. */
45158a91 9918 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 9919 {
333b20bb
GM		 9920 xfree (buf);
9921 UNGCPRO;
9922 return 0;
9923 }
9924
9925 /* Initialize the color table. */
9926 init_color_table ();
9927
9928 /* Process the pixel raster. Origin is in the lower-left corner. */
9929 for (y = 0; y < height; ++y)
9930 {
9931 uint32 *row = buf + y * width;
9932
9933 for (x = 0; x < width; ++x)
9934 {
9935 uint32 abgr = row[x];
9936 int r = TIFFGetR (abgr) << 8;
9937 int g = TIFFGetG (abgr) << 8;
9938 int b = TIFFGetB (abgr) << 8;
9939 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
9940 }
9941 }
9942
9943 /* Remember the colors allocated for the image. Free the color table. */
9944 img->colors = colors_in_color_table (&img->ncolors);
9945 free_color_table ();
f20a3b7a
MB		 9946
9947 img->width = width;
9948 img->height = height;
9949
9950 /* Maybe fill in the background field while we have ximg handy. */
9951 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9952 IMAGE_BACKGROUND (img, f, ximg);
333b20bb
GM		 9953
9954 /* Put the image into the pixmap, then free the X image and its buffer. */
9955 x_put_x_image (f, ximg, img->pixmap, width, height);
9956 x_destroy_x_image (ximg);
9957 xfree (buf);
333b20bb
GM		 9958
9959 UNGCPRO;
9960 return 1;
9961}
9962
9963#endif /* HAVE_TIFF != 0 */
9964
9965
9966\f
9967/***********************************************************************
9968 GIF
9969 ***********************************************************************/
9970
9971#if HAVE_GIF
9972
9973#include <gif_lib.h>
9974
9975static int gif_image_p P_ ((Lisp_Object object));
9976static int gif_load P_ ((struct frame *f, struct image *img));
9977
9978/* The symbol `gif' identifying images of this type. */
9979
9980Lisp_Object Qgif;
9981
9982/* Indices of image specification fields in gif_format, below. */
9983
9984enum gif_keyword_index
9985{
9986 GIF_TYPE,
63448a4d 9987 GIF_DATA,
333b20bb
GM		 9988 GIF_FILE,
9989 GIF_ASCENT,
9990 GIF_MARGIN,
9991 GIF_RELIEF,
9992 GIF_ALGORITHM,
9993 GIF_HEURISTIC_MASK,
4a8e312c 9994 GIF_MASK,
333b20bb 9995 GIF_IMAGE,
f20a3b7a 9996 GIF_BACKGROUND,
333b20bb
GM		 9997 GIF_LAST
9998};
9999
10000/* Vector of image_keyword structures describing the format
10001 of valid user-defined image specifications. */
10002
10003static struct image_keyword gif_format[GIF_LAST] =
10004{
10005 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 10006 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 10007 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 10008 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 10009 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 10010 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 10011 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 10012 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 10013 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f2f0a644 10014 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
f20a3b7a 10015 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 10016};
10017
10018/* Structure describing the image type `gif'. */
10019
10020static struct image_type gif_type =
10021{
10022 &Qgif,
10023 gif_image_p,
10024 gif_load,
10025 x_clear_image,
10026 NULL
10027};
10028
e3130015 10029
333b20bb
GM		 10030/* Return non-zero if OBJECT is a valid GIF image specification. */
10031
10032static int
10033gif_image_p (object)
10034 Lisp_Object object;
10035{
10036 struct image_keyword fmt[GIF_LAST];
10037 bcopy (gif_format, fmt, sizeof fmt);
10038
7c7ff7f5 10039 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
333b20bb 10040 return 0;
5ad6a5fb 10041
63cec32f
GM		 10042 /* Must specify either the :data or :file keyword. */
10043 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
333b20bb
GM		 10044}
10045
e3130015 10046
63448a4d
WP		 10047/* Reading a GIF image from memory
10048 Based on the PNG memory stuff to a certain extent. */
10049
5ad6a5fb
GM		 10050typedef struct
10051{
63448a4d
WP		 10052 unsigned char *bytes;
10053 size_t len;
10054 int index;
5ad6a5fb
GM		 10055}
10056gif_memory_source;
63448a4d 10057
e3130015 10058
f036834a
GM		 10059/* Make the current memory source available to gif_read_from_memory.
10060 It's done this way because not all versions of libungif support
10061 a UserData field in the GifFileType structure. */
10062static gif_memory_source *current_gif_memory_src;
10063
5ad6a5fb
GM		 10064static int
10065gif_read_from_memory (file, buf, len)
10066 GifFileType *file;
10067 GifByteType *buf;
10068 int len;
63448a4d 10069{
f036834a 10070 gif_memory_source *src = current_gif_memory_src;
63448a4d 10071
5ad6a5fb
GM		 10072 if (len > src->len - src->index)
10073 return -1;
63448a4d 10074
5ad6a5fb 10075 bcopy (src->bytes + src->index, buf, len);
63448a4d
WP		 10076 src->index += len;
10077 return len;
10078}
333b20bb 10079
5ad6a5fb 10080
333b20bb
GM		 10081/* Load GIF image IMG for use on frame F. Value is non-zero if
10082 successful. */
10083
10084static int
10085gif_load (f, img)
10086 struct frame *f;
10087 struct image *img;
10088{
10089 Lisp_Object file, specified_file;
63448a4d 10090 Lisp_Object specified_data;
333b20bb
GM		 10091 int rc, width, height, x, y, i;
10092 XImage *ximg;
10093 ColorMapObject *gif_color_map;
10094 unsigned long pixel_colors[256];
10095 GifFileType *gif;
10096 struct gcpro gcpro1;
10097 Lisp_Object image;
10098 int ino, image_left, image_top, image_width, image_height;
63448a4d 10099 gif_memory_source memsrc;
9b784e96 10100 unsigned char *raster;
333b20bb
GM		 10101
10102 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 10103 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 10104 file = Qnil;
10105 GCPRO1 (file);
63448a4d
WP		 10106
10107 if (NILP (specified_data))
5ad6a5fb
GM		 10108 {
10109 file = x_find_image_file (specified_file);
10110 if (!STRINGP (file))
63448a4d 10111 {
45158a91 10112 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM		 10113 UNGCPRO;
10114 return 0;
10115 }
333b20bb 10116
5ad6a5fb
GM		 10117 /* Open the GIF file. */
10118 gif = DGifOpenFileName (XSTRING (file)->data);
10119 if (gif == NULL)
10120 {
10121 image_error ("Cannot open `%s'", file, Qnil);
10122 UNGCPRO;
10123 return 0;
63448a4d 10124 }
5ad6a5fb 10125 }
63448a4d 10126 else
5ad6a5fb
GM		 10127 {
10128 /* Read from memory! */
f036834a 10129 current_gif_memory_src = &memsrc;
5ad6a5fb
GM		 10130 memsrc.bytes = XSTRING (specified_data)->data;
10131 memsrc.len = STRING_BYTES (XSTRING (specified_data));
10132 memsrc.index = 0;
63448a4d 10133
5ad6a5fb
GM		 10134 gif = DGifOpen(&memsrc, gif_read_from_memory);
10135 if (!gif)
10136 {
45158a91 10137 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
5ad6a5fb
GM		 10138 UNGCPRO;
10139 return 0;
63448a4d 10140 }
5ad6a5fb 10141 }
333b20bb
GM		 10142
10143 /* Read entire contents. */
10144 rc = DGifSlurp (gif);
10145 if (rc == GIF_ERROR)
10146 {
45158a91 10147 image_error ("Error reading `%s'", img->spec, Qnil);
333b20bb
GM		 10148 DGifCloseFile (gif);
10149 UNGCPRO;
10150 return 0;
10151 }
10152
3ccff1e3 10153 image = image_spec_value (img->spec, QCindex, NULL);
333b20bb
GM		 10154 ino = INTEGERP (image) ? XFASTINT (image) : 0;
10155 if (ino >= gif->ImageCount)
10156 {
45158a91
GM		 10157 image_error ("Invalid image number `%s' in image `%s'",
10158 image, img->spec);
333b20bb
GM		 10159 DGifCloseFile (gif);
10160 UNGCPRO;
10161 return 0;
10162 }
10163
c7f07c4c
PJ		 10164 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
10165 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
333b20bb 10166
333b20bb 10167 /* Create the X image and pixmap. */
45158a91 10168 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 10169 {
333b20bb
GM		 10170 DGifCloseFile (gif);
10171 UNGCPRO;
10172 return 0;
10173 }
10174
10175 /* Allocate colors. */
10176 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
10177 if (!gif_color_map)
10178 gif_color_map = gif->SColorMap;
10179 init_color_table ();
10180 bzero (pixel_colors, sizeof pixel_colors);
10181
10182 for (i = 0; i < gif_color_map->ColorCount; ++i)
10183 {
10184 int r = gif_color_map->Colors[i].Red << 8;
10185 int g = gif_color_map->Colors[i].Green << 8;
10186 int b = gif_color_map->Colors[i].Blue << 8;
10187 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
10188 }
10189
10190 img->colors = colors_in_color_table (&img->ncolors);
10191 free_color_table ();
10192
10193 /* Clear the part of the screen image that are not covered by
10194 the image from the GIF file. Full animated GIF support
10195 requires more than can be done here (see the gif89 spec,
10196 disposal methods). Let's simply assume that the part
10197 not covered by a sub-image is in the frame's background color. */
10198 image_top = gif->SavedImages[ino].ImageDesc.Top;
10199 image_left = gif->SavedImages[ino].ImageDesc.Left;
10200 image_width = gif->SavedImages[ino].ImageDesc.Width;
10201 image_height = gif->SavedImages[ino].ImageDesc.Height;
10202
10203 for (y = 0; y < image_top; ++y)
10204 for (x = 0; x < width; ++x)
10205 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10206
10207 for (y = image_top + image_height; y < height; ++y)
10208 for (x = 0; x < width; ++x)
10209 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10210
10211 for (y = image_top; y < image_top + image_height; ++y)
10212 {
10213 for (x = 0; x < image_left; ++x)
10214 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10215 for (x = image_left + image_width; x < width; ++x)
10216 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10217 }
10218
9b784e96
GM		 10219 /* Read the GIF image into the X image. We use a local variable
10220 `raster' here because RasterBits below is a char *, and invites
10221 problems with bytes >= 0x80. */
10222 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
10223
333b20bb
GM		 10224 if (gif->SavedImages[ino].ImageDesc.Interlace)
10225 {
10226 static int interlace_start[] = {0, 4, 2, 1};
10227 static int interlace_increment[] = {8, 8, 4, 2};
9b207e8e 10228 int pass;
06482119
GM		 10229 int row = interlace_start[0];
10230
10231 pass = 0;
333b20bb 10232
06482119 10233 for (y = 0; y < image_height; y++)
333b20bb 10234 {
06482119
GM		 10235 if (row >= image_height)
10236 {
10237 row = interlace_start[++pass];
10238 while (row >= image_height)
10239 row = interlace_start[++pass];
10240 }
10241
10242 for (x = 0; x < image_width; x++)
10243 {
9b784e96 10244 int i = raster[(y * image_width) + x];
06482119
GM		 10245 XPutPixel (ximg, x + image_left, row + image_top,
10246 pixel_colors[i]);
10247 }
10248
10249 row += interlace_increment[pass];
333b20bb
GM		 10250 }
10251 }
10252 else
10253 {
10254 for (y = 0; y < image_height; ++y)
10255 for (x = 0; x < image_width; ++x)
10256 {
9b784e96 10257 int i = raster[y * image_width + x];
333b20bb
GM		 10258 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
10259 }
10260 }
10261
10262 DGifCloseFile (gif);
f20a3b7a
MB		 10263
10264 /* Maybe fill in the background field while we have ximg handy. */
10265 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
10266 IMAGE_BACKGROUND (img, f, ximg);
333b20bb
GM		 10267
10268 /* Put the image into the pixmap, then free the X image and its buffer. */
10269 x_put_x_image (f, ximg, img->pixmap, width, height);
10270 x_destroy_x_image (ximg);
333b20bb
GM		 10271
10272 UNGCPRO;
10273 return 1;
10274}
10275
10276#endif /* HAVE_GIF != 0 */
10277
10278
10279\f
10280/***********************************************************************
10281 Ghostscript
10282 ***********************************************************************/
10283
10284static int gs_image_p P_ ((Lisp_Object object));
10285static int gs_load P_ ((struct frame *f, struct image *img));
10286static void gs_clear_image P_ ((struct frame *f, struct image *img));
10287
fcf431dc 10288/* The symbol `postscript' identifying images of this type. */
333b20bb 10289
fcf431dc 10290Lisp_Object Qpostscript;
333b20bb
GM		 10291
10292/* Keyword symbols. */
10293
10294Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
10295
10296/* Indices of image specification fields in gs_format, below. */
10297
10298enum gs_keyword_index
10299{
10300 GS_TYPE,
10301 GS_PT_WIDTH,
10302 GS_PT_HEIGHT,
10303 GS_FILE,
10304 GS_LOADER,
10305 GS_BOUNDING_BOX,
10306 GS_ASCENT,
10307 GS_MARGIN,
10308 GS_RELIEF,
10309 GS_ALGORITHM,
10310 GS_HEURISTIC_MASK,
4a8e312c 10311 GS_MASK,
f20a3b7a 10312 GS_BACKGROUND,
333b20bb
GM		 10313 GS_LAST
10314};
10315
10316/* Vector of image_keyword structures describing the format
10317 of valid user-defined image specifications. */
10318
10319static struct image_keyword gs_format[GS_LAST] =
10320{
10321 {":type", IMAGE_SYMBOL_VALUE, 1},
10322 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
10323 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
10324 {":file", IMAGE_STRING_VALUE, 1},
10325 {":loader", IMAGE_FUNCTION_VALUE, 0},
10326 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
7c7ff7f5 10327 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 10328 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 10329 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 10330 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 10331 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 10332 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10333 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 10334};
10335
10336/* Structure describing the image type `ghostscript'. */
10337
10338static struct image_type gs_type =
10339{
fcf431dc 10340 &Qpostscript,
333b20bb
GM		 10341 gs_image_p,
10342 gs_load,
10343 gs_clear_image,
10344 NULL
10345};
10346
10347
10348/* Free X resources of Ghostscript image IMG which is used on frame F. */
10349
10350static void
10351gs_clear_image (f, img)
10352 struct frame *f;
10353 struct image *img;
10354{
10355 /* IMG->data.ptr_val may contain a recorded colormap. */
10356 xfree (img->data.ptr_val);
10357 x_clear_image (f, img);
10358}
10359
10360
10361/* Return non-zero if OBJECT is a valid Ghostscript image
10362 specification. */
10363
10364static int
10365gs_image_p (object)
10366 Lisp_Object object;
10367{
10368 struct image_keyword fmt[GS_LAST];
10369 Lisp_Object tem;
10370 int i;
10371
10372 bcopy (gs_format, fmt, sizeof fmt);
10373
7c7ff7f5 10374 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
333b20bb
GM		 10375 return 0;
10376
10377 /* Bounding box must be a list or vector containing 4 integers. */
10378 tem = fmt[GS_BOUNDING_BOX].value;
10379 if (CONSP (tem))
10380 {
10381 for (i = 0; i < 4; ++i, tem = XCDR (tem))
10382 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
10383 return 0;
10384 if (!NILP (tem))
10385 return 0;
10386 }
10387 else if (VECTORP (tem))
10388 {
10389 if (XVECTOR (tem)->size != 4)
10390 return 0;
10391 for (i = 0; i < 4; ++i)
10392 if (!INTEGERP (XVECTOR (tem)->contents[i]))
10393 return 0;
10394 }
10395 else
10396 return 0;
10397
10398 return 1;
10399}
10400
10401
10402/* Load Ghostscript image IMG for use on frame F. Value is non-zero
10403 if successful. */
10404
10405static int
10406gs_load (f, img)
10407 struct frame *f;
10408 struct image *img;
10409{
10410 char buffer[100];
10411 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
10412 struct gcpro gcpro1, gcpro2;
10413 Lisp_Object frame;
10414 double in_width, in_height;
10415 Lisp_Object pixel_colors = Qnil;
10416
10417 /* Compute pixel size of pixmap needed from the given size in the
10418 image specification. Sizes in the specification are in pt. 1 pt
10419 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10420 info. */
10421 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
10422 in_width = XFASTINT (pt_width) / 72.0;
10423 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
10424 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
10425 in_height = XFASTINT (pt_height) / 72.0;
10426 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
10427
10428 /* Create the pixmap. */
dd00328a 10429 xassert (img->pixmap == None);
333b20bb
GM		 10430 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10431 img->width, img->height,
10432 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
333b20bb
GM		 10433
10434 if (!img->pixmap)
10435 {
45158a91 10436 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
333b20bb
GM		 10437 return 0;
10438 }
10439
10440 /* Call the loader to fill the pixmap. It returns a process object
10441 if successful. We do not record_unwind_protect here because
10442 other places in redisplay like calling window scroll functions
10443 don't either. Let the Lisp loader use `unwind-protect' instead. */
10444 GCPRO2 (window_and_pixmap_id, pixel_colors);
10445
10446 sprintf (buffer, "%lu %lu",
10447 (unsigned long) FRAME_X_WINDOW (f),
10448 (unsigned long) img->pixmap);
10449 window_and_pixmap_id = build_string (buffer);
10450
10451 sprintf (buffer, "%lu %lu",
10452 FRAME_FOREGROUND_PIXEL (f),
10453 FRAME_BACKGROUND_PIXEL (f));
10454 pixel_colors = build_string (buffer);
10455
10456 XSETFRAME (frame, f);
10457 loader = image_spec_value (img->spec, QCloader, NULL);
10458 if (NILP (loader))
10459 loader = intern ("gs-load-image");
10460
10461 img->data.lisp_val = call6 (loader, frame, img->spec,
10462 make_number (img->width),
10463 make_number (img->height),
10464 window_and_pixmap_id,
10465 pixel_colors);
10466 UNGCPRO;
10467 return PROCESSP (img->data.lisp_val);
10468}
10469
10470
10471/* Kill the Ghostscript process that was started to fill PIXMAP on
10472 frame F. Called from XTread_socket when receiving an event
10473 telling Emacs that Ghostscript has finished drawing. */
10474
10475void
10476x_kill_gs_process (pixmap, f)
10477 Pixmap pixmap;
10478 struct frame *f;
10479{
10480 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
10481 int class, i;
10482 struct image *img;
10483
10484 /* Find the image containing PIXMAP. */
10485 for (i = 0; i < c->used; ++i)
10486 if (c->images[i]->pixmap == pixmap)
10487 break;
10488
daba7643
GM		 10489 /* Should someone in between have cleared the image cache, for
10490 instance, give up. */
10491 if (i == c->used)
10492 return;
10493
333b20bb
GM		 10494 /* Kill the GS process. We should have found PIXMAP in the image
10495 cache and its image should contain a process object. */
333b20bb
GM		 10496 img = c->images[i];
10497 xassert (PROCESSP (img->data.lisp_val));
10498 Fkill_process (img->data.lisp_val, Qnil);
10499 img->data.lisp_val = Qnil;
10500
10501 /* On displays with a mutable colormap, figure out the colors
10502 allocated for the image by looking at the pixels of an XImage for
10503 img->pixmap. */
383d6ffc 10504 class = FRAME_X_VISUAL (f)->class;
333b20bb
GM		 10505 if (class != StaticColor && class != StaticGray && class != TrueColor)
10506 {
10507 XImage *ximg;
10508
10509 BLOCK_INPUT;
10510
10511 /* Try to get an XImage for img->pixmep. */
10512 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
10513 0, 0, img->width, img->height, ~0, ZPixmap);
10514 if (ximg)
10515 {
10516 int x, y;
10517
10518 /* Initialize the color table. */
10519 init_color_table ();
10520
10521 /* For each pixel of the image, look its color up in the
10522 color table. After having done so, the color table will
10523 contain an entry for each color used by the image. */
10524 for (y = 0; y < img->height; ++y)
10525 for (x = 0; x < img->width; ++x)
10526 {
10527 unsigned long pixel = XGetPixel (ximg, x, y);
10528 lookup_pixel_color (f, pixel);
10529 }
10530
10531 /* Record colors in the image. Free color table and XImage. */
10532 img->colors = colors_in_color_table (&img->ncolors);
10533 free_color_table ();
10534 XDestroyImage (ximg);
10535
10536#if 0 /* This doesn't seem to be the case. If we free the colors
10537 here, we get a BadAccess later in x_clear_image when
10538 freeing the colors. */
10539 /* We have allocated colors once, but Ghostscript has also
10540 allocated colors on behalf of us. So, to get the
10541 reference counts right, free them once. */
10542 if (img->ncolors)
462d5d40 10543 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM		 10544#endif
10545 }
10546 else
10547 image_error ("Cannot get X image of `%s'; colors will not be freed",
45158a91 10548 img->spec, Qnil);
333b20bb
GM		 10549
10550 UNBLOCK_INPUT;
10551 }
ad18ffb1
GM		 10552
10553 /* Now that we have the pixmap, compute mask and transform the
10554 image if requested. */
10555 BLOCK_INPUT;
10556 postprocess_image (f, img);
10557 UNBLOCK_INPUT;
333b20bb
GM		 10558}
10559
10560
10561\f
10562/***********************************************************************
10563 Window properties
10564 ***********************************************************************/
10565
10566DEFUN ("x-change-window-property", Fx_change_window_property,
10567 Sx_change_window_property, 2, 3, 0,
7ee72033 10568 doc: /* Change window property PROP to VALUE on the X window of FRAME.
c061c855 10569PROP and VALUE must be strings. FRAME nil or omitted means use the
7ee72033
MB		 10570selected frame. Value is VALUE. */)
10571 (prop, value, frame)
333b20bb
GM		 10572 Lisp_Object frame, prop, value;
10573{
10574 struct frame *f = check_x_frame (frame);
10575 Atom prop_atom;
10576
b7826503
PJ		 10577 CHECK_STRING (prop);
10578 CHECK_STRING (value);
333b20bb
GM		 10579
10580 BLOCK_INPUT;
10581 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10582 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10583 prop_atom, XA_STRING, 8, PropModeReplace,
10584 XSTRING (value)->data, XSTRING (value)->size);
10585
10586 /* Make sure the property is set when we return. */
10587 XFlush (FRAME_X_DISPLAY (f));
10588 UNBLOCK_INPUT;
10589
10590 return value;
10591}
10592
10593
10594DEFUN ("x-delete-window-property", Fx_delete_window_property,
10595 Sx_delete_window_property, 1, 2, 0,
7ee72033
MB		 10596 doc: /* Remove window property PROP from X window of FRAME.
10597FRAME nil or omitted means use the selected frame. Value is PROP. */)
10598 (prop, frame)
333b20bb
GM		 10599 Lisp_Object prop, frame;
10600{
10601 struct frame *f = check_x_frame (frame);
10602 Atom prop_atom;
10603
b7826503 10604 CHECK_STRING (prop);
333b20bb
GM		 10605 BLOCK_INPUT;
10606 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10607 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
10608
10609 /* Make sure the property is removed when we return. */
10610 XFlush (FRAME_X_DISPLAY (f));
10611 UNBLOCK_INPUT;
10612
10613 return prop;
10614}
10615
10616
10617DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
10618 1, 2, 0,
7ee72033 10619 doc: /* Value is the value of window property PROP on FRAME.
c061c855
GM		 10620If FRAME is nil or omitted, use the selected frame. Value is nil
10621if FRAME hasn't a property with name PROP or if PROP has no string
7ee72033
MB		 10622value. */)
10623 (prop, frame)
333b20bb
GM		 10624 Lisp_Object prop, frame;
10625{
10626 struct frame *f = check_x_frame (frame);
10627 Atom prop_atom;
10628 int rc;
10629 Lisp_Object prop_value = Qnil;
10630 char *tmp_data = NULL;
10631 Atom actual_type;
10632 int actual_format;
10633 unsigned long actual_size, bytes_remaining;
10634
b7826503 10635 CHECK_STRING (prop);
333b20bb
GM		 10636 BLOCK_INPUT;
10637 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10638 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10639 prop_atom, 0, 0, False, XA_STRING,
10640 &actual_type, &actual_format, &actual_size,
10641 &bytes_remaining, (unsigned char **) &tmp_data);
10642 if (rc == Success)
10643 {
10644 int size = bytes_remaining;
10645
10646 XFree (tmp_data);
10647 tmp_data = NULL;
10648
10649 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10650 prop_atom, 0, bytes_remaining,
10651 False, XA_STRING,
10652 &actual_type, &actual_format,
10653 &actual_size, &bytes_remaining,
10654 (unsigned char **) &tmp_data);
4c8c7926 10655 if (rc == Success && tmp_data)
333b20bb
GM		 10656 prop_value = make_string (tmp_data, size);
10657
10658 XFree (tmp_data);
10659 }
10660
10661 UNBLOCK_INPUT;
10662 return prop_value;
10663}
10664
10665
10666\f
10667/***********************************************************************
10668 Busy cursor
10669 ***********************************************************************/
10670
4ae9a85e 10671/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 10672 an hourglass cursor on all frames. */
333b20bb 10673
0af913d7 10674static struct atimer *hourglass_atimer;
333b20bb 10675
0af913d7 10676/* Non-zero means an hourglass cursor is currently shown. */
333b20bb 10677
0af913d7 10678static int hourglass_shown_p;
333b20bb 10679
0af913d7 10680/* Number of seconds to wait before displaying an hourglass cursor. */
333b20bb 10681
0af913d7 10682static Lisp_Object Vhourglass_delay;
333b20bb 10683
0af913d7 10684/* Default number of seconds to wait before displaying an hourglass
4ae9a85e
GM		 10685 cursor. */
10686
0af913d7 10687#define DEFAULT_HOURGLASS_DELAY 1
4ae9a85e
GM		 10688
10689/* Function prototypes. */
10690
0af913d7
GM		 10691static void show_hourglass P_ ((struct atimer *));
10692static void hide_hourglass P_ ((void));
4ae9a85e
GM		 10693
10694
0af913d7 10695/* Cancel a currently active hourglass timer, and start a new one. */
4ae9a85e
GM		 10696
10697void
0af913d7 10698start_hourglass ()
333b20bb 10699{
4ae9a85e 10700 EMACS_TIME delay;
3caa99d3 10701 int secs, usecs = 0;
4ae9a85e 10702
0af913d7 10703 cancel_hourglass ();
4ae9a85e 10704
0af913d7
GM		 10705 if (INTEGERP (Vhourglass_delay)
10706 && XINT (Vhourglass_delay) > 0)
10707 secs = XFASTINT (Vhourglass_delay);
10708 else if (FLOATP (Vhourglass_delay)
10709 && XFLOAT_DATA (Vhourglass_delay) > 0)
3caa99d3
GM		 10710 {
10711 Lisp_Object tem;
0af913d7 10712 tem = Ftruncate (Vhourglass_delay, Qnil);
3caa99d3 10713 secs = XFASTINT (tem);
0af913d7 10714 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
3caa99d3 10715 }
4ae9a85e 10716 else
0af913d7 10717 secs = DEFAULT_HOURGLASS_DELAY;
4ae9a85e 10718
3caa99d3 10719 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 10720 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
10721 show_hourglass, NULL);
4ae9a85e
GM		 10722}
10723
10724
0af913d7 10725/* Cancel the hourglass cursor timer if active, hide a busy cursor if
4ae9a85e
GM		 10726 shown. */
10727
10728void
0af913d7 10729cancel_hourglass ()
4ae9a85e 10730{
0af913d7 10731 if (hourglass_atimer)
99f01f62 10732 {
0af913d7
GM		 10733 cancel_atimer (hourglass_atimer);
10734 hourglass_atimer = NULL;
99f01f62
GM		 10735 }
10736
0af913d7
GM		 10737 if (hourglass_shown_p)
10738 hide_hourglass ();
4ae9a85e
GM		 10739}
10740
10741
0af913d7
GM		 10742/* Timer function of hourglass_atimer. TIMER is equal to
10743 hourglass_atimer.
4ae9a85e 10744
0af913d7
GM		 10745 Display an hourglass pointer on all frames by mapping the frames'
10746 hourglass_window. Set the hourglass_p flag in the frames'
10747 output_data.x structure to indicate that an hourglass cursor is
10748 shown on the frames. */
4ae9a85e
GM		 10749
10750static void
0af913d7 10751show_hourglass (timer)
4ae9a85e
GM		 10752 struct atimer *timer;
10753{
10754 /* The timer implementation will cancel this timer automatically
0af913d7 10755 after this function has run. Set hourglass_atimer to null
4ae9a85e 10756 so that we know the timer doesn't have to be canceled. */
0af913d7 10757 hourglass_atimer = NULL;
4ae9a85e 10758
0af913d7 10759 if (!hourglass_shown_p)
333b20bb
GM		 10760 {
10761 Lisp_Object rest, frame;
4ae9a85e
GM		 10762
10763 BLOCK_INPUT;
10764
333b20bb 10765 FOR_EACH_FRAME (rest, frame)
5f7a1890
GM		 10766 {
10767 struct frame *f = XFRAME (frame);
10768
10769 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
10770 {
10771 Display *dpy = FRAME_X_DISPLAY (f);
10772
10773#ifdef USE_X_TOOLKIT
10774 if (f->output_data.x->widget)
10775#else
10776 if (FRAME_OUTER_WINDOW (f))
10777#endif
10778 {
0af913d7 10779 f->output_data.x->hourglass_p = 1;
4ae9a85e 10780
0af913d7 10781 if (!f->output_data.x->hourglass_window)
5f7a1890
GM		 10782 {
10783 unsigned long mask = CWCursor;
10784 XSetWindowAttributes attrs;
4ae9a85e 10785
0af913d7 10786 attrs.cursor = f->output_data.x->hourglass_cursor;
4ae9a85e 10787
0af913d7 10788 f->output_data.x->hourglass_window
5f7a1890
GM		 10789 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
10790 0, 0, 32000, 32000, 0, 0,
10791 InputOnly,
10792 CopyFromParent,
10793 mask, &attrs);
10794 }
4ae9a85e 10795
0af913d7 10796 XMapRaised (dpy, f->output_data.x->hourglass_window);
5f7a1890
GM		 10797 XFlush (dpy);
10798 }
10799 }
10800 }
333b20bb 10801
0af913d7 10802 hourglass_shown_p = 1;
4ae9a85e
GM		 10803 UNBLOCK_INPUT;
10804 }
333b20bb
GM		 10805}
10806
10807
0af913d7
GM		 10808/* Hide the hourglass pointer on all frames, if it is currently
10809 shown. */
333b20bb 10810
4ae9a85e 10811static void
0af913d7 10812hide_hourglass ()
4ae9a85e 10813{
0af913d7 10814 if (hourglass_shown_p)
333b20bb 10815 {
4ae9a85e
GM		 10816 Lisp_Object rest, frame;
10817
10818 BLOCK_INPUT;
10819 FOR_EACH_FRAME (rest, frame)
333b20bb 10820 {
4ae9a85e
GM		 10821 struct frame *f = XFRAME (frame);
10822
10823 if (FRAME_X_P (f)
10824 /* Watch out for newly created frames. */
0af913d7 10825 && f->output_data.x->hourglass_window)
4ae9a85e 10826 {
0af913d7
GM		 10827 XUnmapWindow (FRAME_X_DISPLAY (f),
10828 f->output_data.x->hourglass_window);
10829 /* Sync here because XTread_socket looks at the
10830 hourglass_p flag that is reset to zero below. */
4ae9a85e 10831 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 10832 f->output_data.x->hourglass_p = 0;
4ae9a85e 10833 }
333b20bb 10834 }
333b20bb 10835
0af913d7 10836 hourglass_shown_p = 0;
4ae9a85e
GM		 10837 UNBLOCK_INPUT;
10838 }
333b20bb
GM		 10839}
10840
10841
10842\f
10843/***********************************************************************
10844 Tool tips
10845 ***********************************************************************/
10846
10847static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
275841bf 10848 Lisp_Object, Lisp_Object));
06d62053 10849static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
ab452f99 10850 Lisp_Object, int, int, int *, int *));
333b20bb 10851
44b5a125 10852/* The frame of a currently visible tooltip. */
333b20bb 10853
44b5a125 10854Lisp_Object tip_frame;
333b20bb
GM		 10855
10856/* If non-nil, a timer started that hides the last tooltip when it
10857 fires. */
10858
10859Lisp_Object tip_timer;
10860Window tip_window;
10861
06d62053
GM		 10862/* If non-nil, a vector of 3 elements containing the last args
10863 with which x-show-tip was called. See there. */
10864
10865Lisp_Object last_show_tip_args;
10866
d63931a2
GM		 10867/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10868
10869Lisp_Object Vx_max_tooltip_size;
10870
eaf1eea9
GM		 10871
10872static Lisp_Object
10873unwind_create_tip_frame (frame)
10874 Lisp_Object frame;
10875{
c844a81a
GM		 10876 Lisp_Object deleted;
10877
10878 deleted = unwind_create_frame (frame);
10879 if (EQ (deleted, Qt))
10880 {
10881 tip_window = None;
10882 tip_frame = Qnil;
10883 }
10884
10885 return deleted;
eaf1eea9
GM		 10886}
10887
10888
333b20bb 10889/* Create a frame for a tooltip on the display described by DPYINFO.
275841bf
GM		 10890 PARMS is a list of frame parameters. TEXT is the string to
10891 display in the tip frame. Value is the frame.
eaf1eea9
GM		 10892
10893 Note that functions called here, esp. x_default_parameter can
10894 signal errors, for instance when a specified color name is
10895 undefined. We have to make sure that we're in a consistent state
10896 when this happens. */
333b20bb
GM		 10897
10898static Lisp_Object
275841bf 10899x_create_tip_frame (dpyinfo, parms, text)
333b20bb 10900 struct x_display_info *dpyinfo;
275841bf 10901 Lisp_Object parms, text;
333b20bb
GM		 10902{
10903 struct frame *f;
10904 Lisp_Object frame, tem;
10905 Lisp_Object name;
333b20bb
GM		 10906 long window_prompting = 0;
10907 int width, height;
eaf1eea9 10908 int count = BINDING_STACK_SIZE ();
b6d7acec 10909 struct gcpro gcpro1, gcpro2, gcpro3;
333b20bb 10910 struct kboard *kb;
06d62053 10911 int face_change_count_before = face_change_count;
275841bf
GM		 10912 Lisp_Object buffer;
10913 struct buffer *old_buffer;
333b20bb
GM		 10914
10915 check_x ();
10916
10917 /* Use this general default value to start with until we know if
10918 this frame has a specified name. */
10919 Vx_resource_name = Vinvocation_name;
10920
10921#ifdef MULTI_KBOARD
10922 kb = dpyinfo->kboard;
10923#else
10924 kb = &the_only_kboard;
10925#endif
10926
10927 /* Get the name of the frame to use for resource lookup. */
10928 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
10929 if (!STRINGP (name)
10930 && !EQ (name, Qunbound)
10931 && !NILP (name))
10932 error ("Invalid frame name--not a string or nil");
10933 Vx_resource_name = name;
10934
10935 frame = Qnil;
10936 GCPRO3 (parms, name, frame);
44b5a125 10937 f = make_frame (1);
333b20bb 10938 XSETFRAME (frame, f);
275841bf
GM		 10939
10940 buffer = Fget_buffer_create (build_string (" *tip*"));
10941 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
10942 old_buffer = current_buffer;
10943 set_buffer_internal_1 (XBUFFER (buffer));
d63931a2 10944 current_buffer->truncate_lines = Qnil;
275841bf
GM		 10945 Ferase_buffer ();
10946 Finsert (1, &text);
10947 set_buffer_internal_1 (old_buffer);
10948
333b20bb 10949 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
8a1a7743 10950 record_unwind_protect (unwind_create_tip_frame, frame);
333b20bb 10951
eaf1eea9
GM		 10952 /* By setting the output method, we're essentially saying that
10953 the frame is live, as per FRAME_LIVE_P. If we get a signal
10954 from this point on, x_destroy_window might screw up reference
10955 counts etc. */
333b20bb
GM		 10956 f->output_method = output_x_window;
10957 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
10958 bzero (f->output_data.x, sizeof (struct x_output));
10959 f->output_data.x->icon_bitmap = -1;
10960 f->output_data.x->fontset = -1;
61d461a8
GM		 10961 f->output_data.x->scroll_bar_foreground_pixel = -1;
10962 f->output_data.x->scroll_bar_background_pixel = -1;
f15340b7
MB		 10963#ifdef USE_TOOLKIT_SCROLL_BARS
10964 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
10965 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
10966#endif /* USE_TOOLKIT_SCROLL_BARS */
333b20bb
GM		 10967 f->icon_name = Qnil;
10968 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 10969#if GLYPH_DEBUG
eaf1eea9
GM		 10970 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
10971 dpyinfo_refcount = dpyinfo->reference_count;
10972#endif /* GLYPH_DEBUG */
333b20bb
GM		 10973#ifdef MULTI_KBOARD
10974 FRAME_KBOARD (f) = kb;
10975#endif
10976 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10977 f->output_data.x->explicit_parent = 0;
10978
61d461a8
GM		 10979 /* These colors will be set anyway later, but it's important
10980 to get the color reference counts right, so initialize them! */
10981 {
10982 Lisp_Object black;
10983 struct gcpro gcpro1;
10984
10985 black = build_string ("black");
10986 GCPRO1 (black);
10987 f->output_data.x->foreground_pixel
10988 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10989 f->output_data.x->background_pixel
10990 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10991 f->output_data.x->cursor_pixel
10992 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10993 f->output_data.x->cursor_foreground_pixel
10994 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10995 f->output_data.x->border_pixel
10996 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10997 f->output_data.x->mouse_pixel
10998 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10999 UNGCPRO;
11000 }
11001
333b20bb
GM		 11002 /* Set the name; the functions to which we pass f expect the name to
11003 be set. */
11004 if (EQ (name, Qunbound) || NILP (name))
11005 {
11006 f->name = build_string (dpyinfo->x_id_name);
11007 f->explicit_name = 0;
11008 }
11009 else
11010 {
11011 f->name = name;
11012 f->explicit_name = 1;
11013 /* use the frame's title when getting resources for this frame. */
11014 specbind (Qx_resource_name, name);
11015 }
11016
eaf1eea9
GM		 11017 /* Extract the window parameters from the supplied values that are
11018 needed to determine window geometry. */
333b20bb
GM		 11019 {
11020 Lisp_Object font;
11021
11022 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
11023
11024 BLOCK_INPUT;
11025 /* First, try whatever font the caller has specified. */
11026 if (STRINGP (font))
11027 {
11028 tem = Fquery_fontset (font, Qnil);
11029 if (STRINGP (tem))
11030 font = x_new_fontset (f, XSTRING (tem)->data);
11031 else
11032 font = x_new_font (f, XSTRING (font)->data);
11033 }
11034
11035 /* Try out a font which we hope has bold and italic variations. */
11036 if (!STRINGP (font))
11037 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11038 if (!STRINGP (font))
11039 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11040 if (! STRINGP (font))
11041 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11042 if (! STRINGP (font))
11043 /* This was formerly the first thing tried, but it finds too many fonts
11044 and takes too long. */
11045 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11046 /* If those didn't work, look for something which will at least work. */
11047 if (! STRINGP (font))
11048 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11049 UNBLOCK_INPUT;
11050 if (! STRINGP (font))
11051 font = build_string ("fixed");
11052
11053 x_default_parameter (f, parms, Qfont, font,
11054 "font", "Font", RES_TYPE_STRING);
11055 }
11056
11057 x_default_parameter (f, parms, Qborder_width, make_number (2),
11058 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
11059
11060 /* This defaults to 2 in order to match xterm. We recognize either
11061 internalBorderWidth or internalBorder (which is what xterm calls
11062 it). */
11063 if (NILP (Fassq (Qinternal_border_width, parms)))
11064 {
11065 Lisp_Object value;
11066
11067 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
11068 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
11069 if (! EQ (value, Qunbound))
11070 parms = Fcons (Fcons (Qinternal_border_width, value),
11071 parms);
11072 }
11073
11074 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
11075 "internalBorderWidth", "internalBorderWidth",
11076 RES_TYPE_NUMBER);
11077
11078 /* Also do the stuff which must be set before the window exists. */
11079 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
11080 "foreground", "Foreground", RES_TYPE_STRING);
11081 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
11082 "background", "Background", RES_TYPE_STRING);
11083 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
11084 "pointerColor", "Foreground", RES_TYPE_STRING);
11085 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
11086 "cursorColor", "Foreground", RES_TYPE_STRING);
11087 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
11088 "borderColor", "BorderColor", RES_TYPE_STRING);
11089
11090 /* Init faces before x_default_parameter is called for scroll-bar
11091 parameters because that function calls x_set_scroll_bar_width,
11092 which calls change_frame_size, which calls Fset_window_buffer,
11093 which runs hooks, which call Fvertical_motion. At the end, we
11094 end up in init_iterator with a null face cache, which should not
11095 happen. */
11096 init_frame_faces (f);
11097
11098 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
11099 window_prompting = x_figure_window_size (f, parms);
11100
11101 if (window_prompting & XNegative)
11102 {
11103 if (window_prompting & YNegative)
11104 f->output_data.x->win_gravity = SouthEastGravity;
11105 else
11106 f->output_data.x->win_gravity = NorthEastGravity;
11107 }
11108 else
11109 {
11110 if (window_prompting & YNegative)
11111 f->output_data.x->win_gravity = SouthWestGravity;
11112 else
11113 f->output_data.x->win_gravity = NorthWestGravity;
11114 }
11115
11116 f->output_data.x->size_hint_flags = window_prompting;
11117 {
11118 XSetWindowAttributes attrs;
11119 unsigned long mask;
11120
11121 BLOCK_INPUT;
c51d2b5e
GM		 11122 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
11123 if (DoesSaveUnders (dpyinfo->screen))
11124 mask |= CWSaveUnder;
11125
9b2956e2
GM		 11126 /* Window managers look at the override-redirect flag to determine
11127 whether or net to give windows a decoration (Xlib spec, chapter
333b20bb
GM		 11128 3.2.8). */
11129 attrs.override_redirect = True;
11130 attrs.save_under = True;
11131 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
11132 /* Arrange for getting MapNotify and UnmapNotify events. */
11133 attrs.event_mask = StructureNotifyMask;
11134 tip_window
11135 = FRAME_X_WINDOW (f)
11136 = XCreateWindow (FRAME_X_DISPLAY (f),
11137 FRAME_X_DISPLAY_INFO (f)->root_window,
11138 /* x, y, width, height */
11139 0, 0, 1, 1,
11140 /* Border. */
11141 1,
11142 CopyFromParent, InputOutput, CopyFromParent,
11143 mask, &attrs);
11144 UNBLOCK_INPUT;
11145 }
11146
11147 x_make_gc (f);
11148
333b20bb
GM		 11149 x_default_parameter (f, parms, Qauto_raise, Qnil,
11150 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11151 x_default_parameter (f, parms, Qauto_lower, Qnil,
11152 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11153 x_default_parameter (f, parms, Qcursor_type, Qbox,
11154 "cursorType", "CursorType", RES_TYPE_SYMBOL);
11155
11156 /* Dimensions, especially f->height, must be done via change_frame_size.
11157 Change will not be effected unless different from the current
11158 f->height. */
11159 width = f->width;
11160 height = f->height;
11161 f->height = 0;
11162 SET_FRAME_WIDTH (f, 0);
8938a4fb 11163 change_frame_size (f, height, width, 1, 0, 0);
333b20bb 11164
035d5114 11165 /* Set up faces after all frame parameters are known. This call
6801a572
GM		 11166 also merges in face attributes specified for new frames.
11167
11168 Frame parameters may be changed if .Xdefaults contains
11169 specifications for the default font. For example, if there is an
11170 `Emacs.default.attributeBackground: pink', the `background-color'
11171 attribute of the frame get's set, which let's the internal border
11172 of the tooltip frame appear in pink. Prevent this. */
11173 {
11174 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
11175
11176 /* Set tip_frame here, so that */
11177 tip_frame = frame;
11178 call1 (Qface_set_after_frame_default, frame);
11179
11180 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
11181 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
11182 Qnil));
11183 }
035d5114 11184
333b20bb
GM		 11185 f->no_split = 1;
11186
11187 UNGCPRO;
11188
11189 /* It is now ok to make the frame official even if we get an error
11190 below. And the frame needs to be on Vframe_list or making it
11191 visible won't work. */
11192 Vframe_list = Fcons (frame, Vframe_list);
11193
11194 /* Now that the frame is official, it counts as a reference to
11195 its display. */
11196 FRAME_X_DISPLAY_INFO (f)->reference_count++;
11197
06d62053
GM		 11198 /* Setting attributes of faces of the tooltip frame from resources
11199 and similar will increment face_change_count, which leads to the
11200 clearing of all current matrices. Since this isn't necessary
11201 here, avoid it by resetting face_change_count to the value it
11202 had before we created the tip frame. */
11203 face_change_count = face_change_count_before;
11204
eaf1eea9 11205 /* Discard the unwind_protect. */
333b20bb
GM		 11206 return unbind_to (count, frame);
11207}
11208
11209
06d62053
GM		 11210/* Compute where to display tip frame F. PARMS is the list of frame
11211 parameters for F. DX and DY are specified offsets from the current
ab452f99
GM		 11212 location of the mouse. WIDTH and HEIGHT are the width and height
11213 of the tooltip. Return coordinates relative to the root window of
11214 the display in *ROOT_X, and *ROOT_Y. */
06d62053
GM		 11215
11216static void
ab452f99 11217compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
06d62053
GM		 11218 struct frame *f;
11219 Lisp_Object parms, dx, dy;
ab452f99 11220 int width, height;
06d62053
GM		 11221 int *root_x, *root_y;
11222{
11223 Lisp_Object left, top;
11224 int win_x, win_y;
11225 Window root, child;
11226 unsigned pmask;
11227
11228 /* User-specified position? */
11229 left = Fcdr (Fassq (Qleft, parms));
11230 top = Fcdr (Fassq (Qtop, parms));
11231
11232 /* Move the tooltip window where the mouse pointer is. Resize and
11233 show it. */
570d22b0 11234 if (!INTEGERP (left) || !INTEGERP (top))
ab452f99
GM		 11235 {
11236 BLOCK_INPUT;
11237 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
11238 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
11239 UNBLOCK_INPUT;
11240 }
06d62053 11241
06d62053
GM		 11242 if (INTEGERP (top))
11243 *root_y = XINT (top);
ab452f99
GM		 11244 else if (*root_y + XINT (dy) - height < 0)
11245 *root_y -= XINT (dy);
11246 else
11247 {
11248 *root_y -= height;
11249 *root_y += XINT (dy);
11250 }
11251
11252 if (INTEGERP (left))
11253 *root_x = XINT (left);
d682d3df
RS		 11254 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
11255 /* It fits to the right of the pointer. */
11256 *root_x += XINT (dx);
11257 else if (width + XINT (dx) <= *root_x)
11258 /* It fits to the left of the pointer. */
ab452f99
GM		 11259 *root_x -= width + XINT (dx);
11260 else
d682d3df
RS		 11261 /* Put it left-justified on the screen--it ought to fit that way. */
11262 *root_x = 0;
06d62053
GM		 11263}
11264
11265
0634ce98 11266DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
7ee72033 11267 doc: /* Show STRING in a "tooltip" window on frame FRAME.
c061c855
GM		 11268A tooltip window is a small X window displaying a string.
11269
11270FRAME nil or omitted means use the selected frame.
11271
11272PARMS is an optional list of frame parameters which can be used to
11273change the tooltip's appearance.
11274
11275Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11276means use the default timeout of 5 seconds.
11277
11278If the list of frame parameters PARAMS contains a `left' parameters,
11279the tooltip is displayed at that x-position. Otherwise it is
11280displayed at the mouse position, with offset DX added (default is 5 if
11281DX isn't specified). Likewise for the y-position; if a `top' frame
11282parameter is specified, it determines the y-position of the tooltip
11283window, otherwise it is displayed at the mouse position, with offset
11284DY added (default is -10).
11285
11286A tooltip's maximum size is specified by `x-max-tooltip-size'.
7ee72033
MB		 11287Text larger than the specified size is clipped. */)
11288 (string, frame, parms, timeout, dx, dy)
0634ce98 11289 Lisp_Object string, frame, parms, timeout, dx, dy;
333b20bb
GM		 11290{
11291 struct frame *f;
11292 struct window *w;
06d62053 11293 int root_x, root_y;
333b20bb
GM		 11294 struct buffer *old_buffer;
11295 struct text_pos pos;
11296 int i, width, height;
393f2d14 11297 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
333b20bb 11298 int old_windows_or_buffers_changed = windows_or_buffers_changed;
06d62053 11299 int count = BINDING_STACK_SIZE ();
333b20bb
GM		 11300
11301 specbind (Qinhibit_redisplay, Qt);
11302
393f2d14 11303 GCPRO4 (string, parms, frame, timeout);
333b20bb 11304
b7826503 11305 CHECK_STRING (string);
333b20bb
GM		 11306 f = check_x_frame (frame);
11307 if (NILP (timeout))
11308 timeout = make_number (5);
11309 else
b7826503 11310 CHECK_NATNUM (timeout);
0634ce98
GM		 11311
11312 if (NILP (dx))
11313 dx = make_number (5);
11314 else
b7826503 11315 CHECK_NUMBER (dx);
0634ce98
GM		 11316
11317 if (NILP (dy))
12c67a7f 11318 dy = make_number (-10);
0634ce98 11319 else
b7826503 11320 CHECK_NUMBER (dy);
333b20bb 11321
06d62053
GM		 11322 if (NILP (last_show_tip_args))
11323 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
11324
11325 if (!NILP (tip_frame))
11326 {
11327 Lisp_Object last_string = AREF (last_show_tip_args, 0);
11328 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
11329 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
11330
11331 if (EQ (frame, last_frame)
11332 && !NILP (Fequal (last_string, string))
11333 && !NILP (Fequal (last_parms, parms)))
11334 {
11335 struct frame *f = XFRAME (tip_frame);
11336
11337 /* Only DX and DY have changed. */
11338 if (!NILP (tip_timer))
ae782866
GM		 11339 {
11340 Lisp_Object timer = tip_timer;
11341 tip_timer = Qnil;
11342 call1 (Qcancel_timer, timer);
11343 }
06d62053
GM		 11344
11345 BLOCK_INPUT;
ab452f99
GM		 11346 compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
11347 PIXEL_HEIGHT (f), &root_x, &root_y);
06d62053 11348 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11349 root_x, root_y);
06d62053
GM		 11350 UNBLOCK_INPUT;
11351 goto start_timer;
11352 }
11353 }
11354
333b20bb
GM		 11355 /* Hide a previous tip, if any. */
11356 Fx_hide_tip ();
11357
06d62053
GM		 11358 ASET (last_show_tip_args, 0, string);
11359 ASET (last_show_tip_args, 1, frame);
11360 ASET (last_show_tip_args, 2, parms);
11361
333b20bb
GM		 11362 /* Add default values to frame parameters. */
11363 if (NILP (Fassq (Qname, parms)))
11364 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
11365 if (NILP (Fassq (Qinternal_border_width, parms)))
11366 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
11367 if (NILP (Fassq (Qborder_width, parms)))
11368 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
11369 if (NILP (Fassq (Qborder_color, parms)))
11370 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
11371 if (NILP (Fassq (Qbackground_color, parms)))
11372 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
11373 parms);
11374
11375 /* Create a frame for the tooltip, and record it in the global
11376 variable tip_frame. */
275841bf 11377 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
44b5a125 11378 f = XFRAME (frame);
333b20bb 11379
d63931a2 11380 /* Set up the frame's root window. */
333b20bb
GM		 11381 w = XWINDOW (FRAME_ROOT_WINDOW (f));
11382 w->left = w->top = make_number (0);
d63931a2
GM		 11383
11384 if (CONSP (Vx_max_tooltip_size)
11385 && INTEGERP (XCAR (Vx_max_tooltip_size))
11386 && XINT (XCAR (Vx_max_tooltip_size)) > 0
11387 && INTEGERP (XCDR (Vx_max_tooltip_size))
11388 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
11389 {
11390 w->width = XCAR (Vx_max_tooltip_size);
11391 w->height = XCDR (Vx_max_tooltip_size);
11392 }
11393 else
11394 {
11395 w->width = make_number (80);
11396 w->height = make_number (40);
11397 }
11398
11399 f->window_width = XINT (w->width);
333b20bb
GM		 11400 adjust_glyphs (f);
11401 w->pseudo_window_p = 1;
11402
11403 /* Display the tooltip text in a temporary buffer. */
333b20bb 11404 old_buffer = current_buffer;
275841bf 11405 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
d63931a2 11406 current_buffer->truncate_lines = Qnil;
333b20bb
GM		 11407 clear_glyph_matrix (w->desired_matrix);
11408 clear_glyph_matrix (w->current_matrix);
11409 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
11410 try_window (FRAME_ROOT_WINDOW (f), pos);
11411
11412 /* Compute width and height of the tooltip. */
11413 width = height = 0;
11414 for (i = 0; i < w->desired_matrix->nrows; ++i)
11415 {
11416 struct glyph_row *row = &w->desired_matrix->rows[i];
11417 struct glyph *last;
11418 int row_width;
11419
11420 /* Stop at the first empty row at the end. */
11421 if (!row->enabled_p || !row->displays_text_p)
11422 break;
11423
d7bf0342
GM		 11424 /* Let the row go over the full width of the frame. */
11425 row->full_width_p = 1;
333b20bb 11426
e3130015 11427 /* There's a glyph at the end of rows that is used to place
333b20bb
GM		 11428 the cursor there. Don't include the width of this glyph. */
11429 if (row->used[TEXT_AREA])
11430 {
11431 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
11432 row_width = row->pixel_width - last->pixel_width;
11433 }
11434 else
11435 row_width = row->pixel_width;
11436
11437 height += row->height;
11438 width = max (width, row_width);
11439 }
11440
11441 /* Add the frame's internal border to the width and height the X
11442 window should have. */
11443 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11444 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11445
11446 /* Move the tooltip window where the mouse pointer is. Resize and
11447 show it. */
ab452f99 11448 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
0634ce98 11449
0634ce98 11450 BLOCK_INPUT;
333b20bb 11451 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11452 root_x, root_y, width, height);
333b20bb
GM		 11453 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
11454 UNBLOCK_INPUT;
06d62053 11455
333b20bb
GM		 11456 /* Draw into the window. */
11457 w->must_be_updated_p = 1;
11458 update_single_window (w, 1);
11459
11460 /* Restore original current buffer. */
11461 set_buffer_internal_1 (old_buffer);
11462 windows_or_buffers_changed = old_windows_or_buffers_changed;
11463
06d62053 11464 start_timer:
333b20bb
GM		 11465 /* Let the tip disappear after timeout seconds. */
11466 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
11467 intern ("x-hide-tip"));
a744a2ec
DL		 11468
11469 UNGCPRO;
333b20bb
GM		 11470 return unbind_to (count, Qnil);
11471}
11472
11473
11474DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
7ee72033
MB		 11475 doc: /* Hide the current tooltip window, if there is any.
11476Value is t if tooltip was open, nil otherwise. */)
11477 ()
333b20bb 11478{
44b5a125 11479 int count;
c0006262
GM		 11480 Lisp_Object deleted, frame, timer;
11481 struct gcpro gcpro1, gcpro2;
44b5a125
GM		 11482
11483 /* Return quickly if nothing to do. */
c0006262 11484 if (NILP (tip_timer) && NILP (tip_frame))
44b5a125 11485 return Qnil;
333b20bb 11486
c0006262
GM		 11487 frame = tip_frame;
11488 timer = tip_timer;
11489 GCPRO2 (frame, timer);
11490 tip_frame = tip_timer = deleted = Qnil;
11491
44b5a125 11492 count = BINDING_STACK_SIZE ();
333b20bb 11493 specbind (Qinhibit_redisplay, Qt);
44b5a125 11494 specbind (Qinhibit_quit, Qt);
333b20bb 11495
c0006262 11496 if (!NILP (timer))
ae782866 11497 call1 (Qcancel_timer, timer);
333b20bb 11498
c0006262 11499 if (FRAMEP (frame))
333b20bb 11500 {
44b5a125
GM		 11501 Fdelete_frame (frame, Qnil);
11502 deleted = Qt;
f6c44811
GM		 11503
11504#ifdef USE_LUCID
11505 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11506 redisplay procedure is not called when a tip frame over menu
11507 items is unmapped. Redisplay the menu manually... */
11508 {
11509 struct frame *f = SELECTED_FRAME ();
11510 Widget w = f->output_data.x->menubar_widget;
11511 extern void xlwmenu_redisplay P_ ((Widget));
9180dc8c 11512
f6c44811 11513 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
dbc64aa7 11514 && w != NULL)
f6c44811
GM		 11515 {
11516 BLOCK_INPUT;
11517 xlwmenu_redisplay (w);
11518 UNBLOCK_INPUT;
11519 }
11520 }
11521#endif /* USE_LUCID */
333b20bb
GM		 11522 }
11523
c0006262 11524 UNGCPRO;
44b5a125 11525 return unbind_to (count, deleted);
333b20bb
GM		 11526}
11527
11528
11529\f
11530/***********************************************************************
11531 File selection dialog
11532 ***********************************************************************/
11533
11534#ifdef USE_MOTIF
11535
11536/* Callback for "OK" and "Cancel" on file selection dialog. */
11537
11538static void
11539file_dialog_cb (widget, client_data, call_data)
11540 Widget widget;
11541 XtPointer call_data, client_data;
11542{
11543 int *result = (int *) client_data;
11544 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
11545 *result = cb->reason;
11546}
11547
11548
a779d213
GM		 11549/* Callback for unmapping a file selection dialog. This is used to
11550 capture the case where a dialog is closed via a window manager's
11551 closer button, for example. Using a XmNdestroyCallback didn't work
11552 in this case. */
11553
11554static void
11555file_dialog_unmap_cb (widget, client_data, call_data)
11556 Widget widget;
11557 XtPointer call_data, client_data;
11558{
11559 int *result = (int *) client_data;
11560 *result = XmCR_CANCEL;
11561}
11562
11563
333b20bb 11564DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
7ee72033 11565 doc: /* Read file name, prompting with PROMPT in directory DIR.
c061c855
GM		 11566Use a file selection dialog.
11567Select DEFAULT-FILENAME in the dialog's file selection box, if
11568specified. Don't let the user enter a file name in the file
7ee72033
MB		 11569selection dialog's entry field, if MUSTMATCH is non-nil. */)
11570 (prompt, dir, default_filename, mustmatch)
333b20bb
GM		 11571 Lisp_Object prompt, dir, default_filename, mustmatch;
11572{
11573 int result;
0fe92f72 11574 struct frame *f = SELECTED_FRAME ();
333b20bb
GM		 11575 Lisp_Object file = Qnil;
11576 Widget dialog, text, list, help;
11577 Arg al[10];
11578 int ac = 0;
11579 extern XtAppContext Xt_app_con;
333b20bb 11580 XmString dir_xmstring, pattern_xmstring;
333b20bb
GM		 11581 int count = specpdl_ptr - specpdl;
11582 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
11583
11584 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
b7826503
PJ		 11585 CHECK_STRING (prompt);
11586 CHECK_STRING (dir);
333b20bb
GM		 11587
11588 /* Prevent redisplay. */
11589 specbind (Qinhibit_redisplay, Qt);
11590
11591 BLOCK_INPUT;
11592
11593 /* Create the dialog with PROMPT as title, using DIR as initial
11594 directory and using "*" as pattern. */
11595 dir = Fexpand_file_name (dir, Qnil);
11596 dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
11597 pattern_xmstring = XmStringCreateLocalized ("*");
11598
11599 XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
11600 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
11601 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
11602 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
11603 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
11604 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
11605 "fsb", al, ac);
11606 XmStringFree (dir_xmstring);
11607 XmStringFree (pattern_xmstring);
11608
11609 /* Add callbacks for OK and Cancel. */
11610 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
11611 (XtPointer) &result);
11612 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
11613 (XtPointer) &result);
a779d213
GM		 11614 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
11615 (XtPointer) &result);
333b20bb
GM		 11616
11617 /* Disable the help button since we can't display help. */
11618 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
11619 XtSetSensitive (help, False);
11620
11621 /* Mark OK button as default. */
11622 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
11623 XmNshowAsDefault, True, NULL);
11624
11625 /* If MUSTMATCH is non-nil, disable the file entry field of the
11626 dialog, so that the user must select a file from the files list
11627 box. We can't remove it because we wouldn't have a way to get at
11628 the result file name, then. */
11629 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
11630 if (!NILP (mustmatch))
11631 {
11632 Widget label;
11633 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
11634 XtSetSensitive (text, False);
11635 XtSetSensitive (label, False);
11636 }
11637
11638 /* Manage the dialog, so that list boxes get filled. */
11639 XtManageChild (dialog);
11640
11641 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11642 must include the path for this to work. */
11643 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
11644 if (STRINGP (default_filename))
11645 {
11646 XmString default_xmstring;
11647 int item_pos;
11648
11649 default_xmstring
11650 = XmStringCreateLocalized (XSTRING (default_filename)->data);
11651
11652 if (!XmListItemExists (list, default_xmstring))
11653 {
11654 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11655 XmListAddItem (list, default_xmstring, 0);
11656 item_pos = 0;
11657 }
11658 else
11659 item_pos = XmListItemPos (list, default_xmstring);
11660 XmStringFree (default_xmstring);
11661
11662 /* Select the item and scroll it into view. */
11663 XmListSelectPos (list, item_pos, True);
11664 XmListSetPos (list, item_pos);
11665 }
11666
563b384d
GM		 11667 /* Process events until the user presses Cancel or OK. Block
11668 and unblock input here so that we get a chance of processing
11669 expose events. */
11670 UNBLOCK_INPUT;
03100098 11671 result = 0;
a779d213 11672 while (result == 0)
563b384d
GM		 11673 {
11674 BLOCK_INPUT;
11675 XtAppProcessEvent (Xt_app_con, XtIMAll);
11676 UNBLOCK_INPUT;
11677 }
11678 BLOCK_INPUT;
03100098 11679
333b20bb
GM		 11680 /* Get the result. */
11681 if (result == XmCR_OK)
11682 {
11683 XmString text;
11684 String data;
11685
d1670063 11686 XtVaGetValues (dialog, XmNtextString, &text, NULL);
333b20bb
GM		 11687 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
11688 XmStringFree (text);
11689 file = build_string (data);
11690 XtFree (data);
11691 }
11692 else
11693 file = Qnil;
11694
11695 /* Clean up. */
11696 XtUnmanageChild (dialog);
11697 XtDestroyWidget (dialog);
11698 UNBLOCK_INPUT;
11699 UNGCPRO;
11700
11701 /* Make "Cancel" equivalent to C-g. */
11702 if (NILP (file))
11703 Fsignal (Qquit, Qnil);
11704
11705 return unbind_to (count, file);
11706}
11707
11708#endif /* USE_MOTIF */
11709
333b20bb
GM		 11710
11711\f
82bab41c
GM		 11712/***********************************************************************
11713 Keyboard
11714 ***********************************************************************/
11715
11716#ifdef HAVE_XKBGETKEYBOARD
11717#include <X11/XKBlib.h>
11718#include <X11/keysym.h>
11719#endif
11720
11721DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
11722 Sx_backspace_delete_keys_p, 0, 1, 0,
7ee72033 11723 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
c061c855
GM		 11724FRAME nil means use the selected frame.
11725Value is t if we know that both keys are present, and are mapped to the
7ee72033
MB		 11726usual X keysyms. */)
11727 (frame)
82bab41c
GM		 11728 Lisp_Object frame;
11729{
11730#ifdef HAVE_XKBGETKEYBOARD
11731 XkbDescPtr kb;
11732 struct frame *f = check_x_frame (frame);
11733 Display *dpy = FRAME_X_DISPLAY (f);
11734 Lisp_Object have_keys;
46f6a258 11735 int major, minor, op, event, error;
82bab41c
GM		 11736
11737 BLOCK_INPUT;
46f6a258
GM		 11738
11739 /* Check library version in case we're dynamically linked. */
11740 major = XkbMajorVersion;
11741 minor = XkbMinorVersion;
11742 if (!XkbLibraryVersion (&major, &minor))
c1efd260
GM		 11743 {
11744 UNBLOCK_INPUT;
11745 return Qnil;
11746 }
46f6a258
GM		 11747
11748 /* Check that the server supports XKB. */
11749 major = XkbMajorVersion;
11750 minor = XkbMinorVersion;
11751 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
c1efd260
GM		 11752 {
11753 UNBLOCK_INPUT;
11754 return Qnil;
11755 }
46f6a258
GM		 11756
11757 have_keys = Qnil;
c1efd260 11758 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
82bab41c
GM		 11759 if (kb)
11760 {
11761 int delete_keycode = 0, backspace_keycode = 0, i;
c1efd260
GM		 11762
11763 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
82bab41c 11764 {
c1efd260
GM		 11765 for (i = kb->min_key_code;
11766 (i < kb->max_key_code
11767 && (delete_keycode == 0 || backspace_keycode == 0));
11768 ++i)
11769 {
d63931a2
GM		 11770 /* The XKB symbolic key names can be seen most easily in
11771 the PS file generated by `xkbprint -label name
11772 $DISPLAY'. */
c1efd260
GM		 11773 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
11774 delete_keycode = i;
11775 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
11776 backspace_keycode = i;
11777 }
11778
11779 XkbFreeNames (kb, 0, True);
82bab41c
GM		 11780 }
11781
c1efd260 11782 XkbFreeClientMap (kb, 0, True);
82bab41c
GM		 11783
11784 if (delete_keycode
11785 && backspace_keycode
11786 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
11787 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
11788 have_keys = Qt;
11789 }
11790 UNBLOCK_INPUT;
11791 return have_keys;
11792#else /* not HAVE_XKBGETKEYBOARD */
11793 return Qnil;
11794#endif /* not HAVE_XKBGETKEYBOARD */
11795}
11796
11797
11798\f
333b20bb
GM		 11799/***********************************************************************
11800 Initialization
11801 ***********************************************************************/
11802
11803void
11804syms_of_xfns ()
11805{
11806 /* This is zero if not using X windows. */
11807 x_in_use = 0;
11808
11809 /* The section below is built by the lisp expression at the top of the file,
11810 just above where these variables are declared. */
11811 /*&&& init symbols here &&&*/
11812 Qauto_raise = intern ("auto-raise");
11813 staticpro (&Qauto_raise);
11814 Qauto_lower = intern ("auto-lower");
11815 staticpro (&Qauto_lower);
11816 Qbar = intern ("bar");
dbc4e1c1 11817 staticpro (&Qbar);
f9942c9e
JB		 11818 Qborder_color = intern ("border-color");
11819 staticpro (&Qborder_color);
11820 Qborder_width = intern ("border-width");
11821 staticpro (&Qborder_width);
dbc4e1c1
JB		 11822 Qbox = intern ("box");
11823 staticpro (&Qbox);
f9942c9e
JB		 11824 Qcursor_color = intern ("cursor-color");
11825 staticpro (&Qcursor_color);
dbc4e1c1
JB		 11826 Qcursor_type = intern ("cursor-type");
11827 staticpro (&Qcursor_type);
f9942c9e
JB		 11828 Qgeometry = intern ("geometry");
11829 staticpro (&Qgeometry);
f9942c9e
JB		 11830 Qicon_left = intern ("icon-left");
11831 staticpro (&Qicon_left);
11832 Qicon_top = intern ("icon-top");
11833 staticpro (&Qicon_top);
11834 Qicon_type = intern ("icon-type");
11835 staticpro (&Qicon_type);
80534dd6
KH		 11836 Qicon_name = intern ("icon-name");
11837 staticpro (&Qicon_name);
f9942c9e
JB		 11838 Qinternal_border_width = intern ("internal-border-width");
11839 staticpro (&Qinternal_border_width);
11840 Qleft = intern ("left");
11841 staticpro (&Qleft);
1ab3d87e
RS		 11842 Qright = intern ("right");
11843 staticpro (&Qright);
f9942c9e
JB		 11844 Qmouse_color = intern ("mouse-color");
11845 staticpro (&Qmouse_color);
baaed68e
JB		 11846 Qnone = intern ("none");
11847 staticpro (&Qnone);
f9942c9e
JB		 11848 Qparent_id = intern ("parent-id");
11849 staticpro (&Qparent_id);
4701395c
KH		 11850 Qscroll_bar_width = intern ("scroll-bar-width");
11851 staticpro (&Qscroll_bar_width);
8af1d7ca
JB		 11852 Qsuppress_icon = intern ("suppress-icon");
11853 staticpro (&Qsuppress_icon);
01f1ba30 11854 Qundefined_color = intern ("undefined-color");
f9942c9e 11855 staticpro (&Qundefined_color);
a3c87d4e
JB		 11856 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
11857 staticpro (&Qvertical_scroll_bars);
49795535
JB		 11858 Qvisibility = intern ("visibility");
11859 staticpro (&Qvisibility);
f9942c9e
JB		 11860 Qwindow_id = intern ("window-id");
11861 staticpro (&Qwindow_id);
2cbebefb
RS		 11862 Qouter_window_id = intern ("outer-window-id");
11863 staticpro (&Qouter_window_id);
f9942c9e
JB		 11864 Qx_frame_parameter = intern ("x-frame-parameter");
11865 staticpro (&Qx_frame_parameter);
9ef48a9d
RS		 11866 Qx_resource_name = intern ("x-resource-name");
11867 staticpro (&Qx_resource_name);
4fe1de12
RS		 11868 Quser_position = intern ("user-position");
11869 staticpro (&Quser_position);
11870 Quser_size = intern ("user-size");
11871 staticpro (&Quser_size);
333b20bb
GM		 11872 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
11873 staticpro (&Qscroll_bar_foreground);
11874 Qscroll_bar_background = intern ("scroll-bar-background");
11875 staticpro (&Qscroll_bar_background);
d62c8769
GM		 11876 Qscreen_gamma = intern ("screen-gamma");
11877 staticpro (&Qscreen_gamma);
563b67aa
GM		 11878 Qline_spacing = intern ("line-spacing");
11879 staticpro (&Qline_spacing);
7c7ff7f5
GM		 11880 Qcenter = intern ("center");
11881 staticpro (&Qcenter);
96db09e4
KH		 11882 Qcompound_text = intern ("compound-text");
11883 staticpro (&Qcompound_text);
ae782866
GM		 11884 Qcancel_timer = intern ("cancel-timer");
11885 staticpro (&Qcancel_timer);
ea0a1f53
GM		 11886 Qwait_for_wm = intern ("wait-for-wm");
11887 staticpro (&Qwait_for_wm);
49d41073
EZ		 11888 Qfullscreen = intern ("fullscreen");
11889 staticpro (&Qfullscreen);
11890 Qfullwidth = intern ("fullwidth");
11891 staticpro (&Qfullwidth);
11892 Qfullheight = intern ("fullheight");
11893 staticpro (&Qfullheight);
11894 Qfullboth = intern ("fullboth");
11895 staticpro (&Qfullboth);
f9942c9e
JB		 11896 /* This is the end of symbol initialization. */
11897
58cad5ed
KH		 11898 /* Text property `display' should be nonsticky by default. */
11899 Vtext_property_default_nonsticky
11900 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
11901
11902
333b20bb
GM		 11903 Qlaplace = intern ("laplace");
11904 staticpro (&Qlaplace);
4a8e312c
GM		 11905 Qemboss = intern ("emboss");
11906 staticpro (&Qemboss);
11907 Qedge_detection = intern ("edge-detection");
11908 staticpro (&Qedge_detection);
11909 Qheuristic = intern ("heuristic");
11910 staticpro (&Qheuristic);
11911 QCmatrix = intern (":matrix");
11912 staticpro (&QCmatrix);
11913 QCcolor_adjustment = intern (":color-adjustment");
11914 staticpro (&QCcolor_adjustment);
11915 QCmask = intern (":mask");
11916 staticpro (&QCmask);
11917
a367641f
RS		 11918 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
11919 staticpro (&Qface_set_after_frame_default);
11920
01f1ba30
JB		 11921 Fput (Qundefined_color, Qerror_conditions,
11922 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
11923 Fput (Qundefined_color, Qerror_message,
11924 build_string ("Undefined color"));
11925
f9942c9e
JB		 11926 init_x_parm_symbols ();
11927
7ee72033
MB		 11928 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
11929 doc: /* Non-nil means always draw a cross over disabled images.
c061c855
GM		 11930Disabled images are those having an `:conversion disabled' property.
11931A cross is always drawn on black & white displays. */);
14819cb3
GM		 11932 cross_disabled_images = 0;
11933
7ee72033
MB		 11934 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
11935 doc: /* List of directories to search for bitmap files for X. */);
e241c09b 11936 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
f1c7b5a6 11937
7ee72033
MB		 11938 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
11939 doc: /* The shape of the pointer when over text.
c061c855
GM		 11940Changing the value does not affect existing frames
11941unless you set the mouse color. */);
01f1ba30
JB		 11942 Vx_pointer_shape = Qnil;
11943
7ee72033
MB		 11944 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
11945 doc: /* The name Emacs uses to look up X resources.
c061c855
GM		 11946`x-get-resource' uses this as the first component of the instance name
11947when requesting resource values.
11948Emacs initially sets `x-resource-name' to the name under which Emacs
11949was invoked, or to the value specified with the `-name' or `-rn'
11950switches, if present.
11951
11952It may be useful to bind this variable locally around a call
11953to `x-get-resource'. See also the variable `x-resource-class'. */);
d387c960 11954 Vx_resource_name = Qnil;
ac63d3d6 11955
7ee72033
MB		 11956 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
11957 doc: /* The class Emacs uses to look up X resources.
c061c855
GM		 11958`x-get-resource' uses this as the first component of the instance class
11959when requesting resource values.
11960
11961Emacs initially sets `x-resource-class' to "Emacs".
11962
11963Setting this variable permanently is not a reasonable thing to do,
11964but binding this variable locally around a call to `x-get-resource'
11965is a reasonable practice. See also the variable `x-resource-name'. */);
498e9ac3
RS		 11966 Vx_resource_class = build_string (EMACS_CLASS);
11967
ca0ecbf5 11968#if 0 /* This doesn't really do anything. */
7ee72033
MB		 11969 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
11970 doc: /* The shape of the pointer when not over text.
c061c855
GM		 11971This variable takes effect when you create a new frame
11972or when you set the mouse color. */);
af01ef26 11973#endif
01f1ba30
JB		 11974 Vx_nontext_pointer_shape = Qnil;
11975
7ee72033
MB		 11976 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
11977 doc: /* The shape of the pointer when Emacs is busy.
c061c855
GM		 11978This variable takes effect when you create a new frame
11979or when you set the mouse color. */);
0af913d7 11980 Vx_hourglass_pointer_shape = Qnil;
333b20bb 11981
7ee72033
MB		 11982 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
11983 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 11984 display_hourglass_p = 1;
333b20bb 11985
7ee72033
MB		 11986 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
11987 doc: /* *Seconds to wait before displaying an hourglass pointer.
c061c855 11988Value must be an integer or float. */);
0af913d7 11989 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
4ae9a85e 11990
ca0ecbf5 11991#if 0 /* This doesn't really do anything. */
7ee72033
MB		 11992 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
11993 doc: /* The shape of the pointer when over the mode line.
c061c855
GM		 11994This variable takes effect when you create a new frame
11995or when you set the mouse color. */);
af01ef26 11996#endif
01f1ba30
JB		 11997 Vx_mode_pointer_shape = Qnil;
11998
d3b06468 11999 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7ee72033
MB		 12000 &Vx_sensitive_text_pointer_shape,
12001 doc: /* The shape of the pointer when over mouse-sensitive text.
c061c855
GM		 12002This variable takes effect when you create a new frame
12003or when you set the mouse color. */);
ca0ecbf5 12004 Vx_sensitive_text_pointer_shape = Qnil;
95f80c78 12005
8fb4ec9c 12006 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7ee72033
MB		 12007 &Vx_window_horizontal_drag_shape,
12008 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
c061c855
GM		 12009This variable takes effect when you create a new frame
12010or when you set the mouse color. */);
8fb4ec9c
GM		 12011 Vx_window_horizontal_drag_shape = Qnil;
12012
7ee72033
MB		 12013 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
12014 doc: /* A string indicating the foreground color of the cursor box. */);
01f1ba30
JB		 12015 Vx_cursor_fore_pixel = Qnil;
12016
7ee72033
MB		 12017 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
12018 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
c061c855 12019Text larger than this is clipped. */);
d63931a2
GM		 12020 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
12021
7ee72033
MB		 12022 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
12023 doc: /* Non-nil if no X window manager is in use.
c061c855
GM		 12024Emacs doesn't try to figure this out; this is always nil
12025unless you set it to something else. */);
2d38195d
RS		 12026 /* We don't have any way to find this out, so set it to nil
12027 and maybe the user would like to set it to t. */
12028 Vx_no_window_manager = Qnil;
1d3dac41 12029
942ea06d 12030 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7ee72033
MB		 12031 &Vx_pixel_size_width_font_regexp,
12032 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
c061c855
GM		 12033
12034Since Emacs gets width of a font matching with this regexp from
12035PIXEL_SIZE field of the name, font finding mechanism gets faster for
12036such a font. This is especially effective for such large fonts as
12037Chinese, Japanese, and Korean. */);
942ea06d
KH		 12038 Vx_pixel_size_width_font_regexp = Qnil;
12039
7ee72033
MB		 12040 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
12041 doc: /* Time after which cached images are removed from the cache.
c061c855
GM		 12042When an image has not been displayed this many seconds, remove it
12043from the image cache. Value must be an integer or nil with nil
12044meaning don't clear the cache. */);
fcf431dc 12045 Vimage_cache_eviction_delay = make_number (30 * 60);
333b20bb 12046
1d3dac41 12047#ifdef USE_X_TOOLKIT
6f3f6a8d 12048 Fprovide (intern ("x-toolkit"), Qnil);
5b827abb 12049#ifdef USE_MOTIF
6f3f6a8d 12050 Fprovide (intern ("motif"), Qnil);
fc2cdd9a 12051
7ee72033
MB		 12052 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
12053 doc: /* Version info for LessTif/Motif. */);
fc2cdd9a
GM		 12054 Vmotif_version_string = build_string (XmVERSION_STRING);
12055#endif /* USE_MOTIF */
12056#endif /* USE_X_TOOLKIT */
01f1ba30 12057
01f1ba30 12058 defsubr (&Sx_get_resource);
333b20bb
GM		 12059
12060 /* X window properties. */
12061 defsubr (&Sx_change_window_property);
12062 defsubr (&Sx_delete_window_property);
12063 defsubr (&Sx_window_property);
12064
2d764c78 12065 defsubr (&Sxw_display_color_p);
d0c9d219 12066 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 12067 defsubr (&Sxw_color_defined_p);
12068 defsubr (&Sxw_color_values);
9d317b2c 12069 defsubr (&Sx_server_max_request_size);
41beb8fc
RS		 12070 defsubr (&Sx_server_vendor);
12071 defsubr (&Sx_server_version);
12072 defsubr (&Sx_display_pixel_width);
12073 defsubr (&Sx_display_pixel_height);
12074 defsubr (&Sx_display_mm_width);
12075 defsubr (&Sx_display_mm_height);
12076 defsubr (&Sx_display_screens);
12077 defsubr (&Sx_display_planes);
12078 defsubr (&Sx_display_color_cells);
12079 defsubr (&Sx_display_visual_class);
12080 defsubr (&Sx_display_backing_store);
12081 defsubr (&Sx_display_save_under);
8af1d7ca 12082 defsubr (&Sx_parse_geometry);
f676886a 12083 defsubr (&Sx_create_frame);
01f1ba30 12084 defsubr (&Sx_open_connection);
08a90d6a
RS		 12085 defsubr (&Sx_close_connection);
12086 defsubr (&Sx_display_list);
01f1ba30 12087 defsubr (&Sx_synchronize);
3decc1e7 12088 defsubr (&Sx_focus_frame);
82bab41c
GM		 12089 defsubr (&Sx_backspace_delete_keys_p);
12090
942ea06d
KH		 12091 /* Setting callback functions for fontset handler. */
12092 get_font_info_func = x_get_font_info;
333b20bb
GM		 12093
12094#if 0 /* This function pointer doesn't seem to be used anywhere.
12095 And the pointer assigned has the wrong type, anyway. */
942ea06d 12096 list_fonts_func = x_list_fonts;
333b20bb
GM		 12097#endif
12098
942ea06d 12099 load_font_func = x_load_font;
bc1958c4 12100 find_ccl_program_func = x_find_ccl_program;
942ea06d
KH		 12101 query_font_func = x_query_font;
12102 set_frame_fontset_func = x_set_font;
12103 check_window_system_func = check_x;
333b20bb
GM		 12104
12105 /* Images. */
12106 Qxbm = intern ("xbm");
12107 staticpro (&Qxbm);
12108 QCtype = intern (":type");
12109 staticpro (&QCtype);
d2dc8167
GM		 12110 QCconversion = intern (":conversion");
12111 staticpro (&QCconversion);
333b20bb
GM		 12112 QCheuristic_mask = intern (":heuristic-mask");
12113 staticpro (&QCheuristic_mask);
12114 QCcolor_symbols = intern (":color-symbols");
12115 staticpro (&QCcolor_symbols);
333b20bb
GM		 12116 QCascent = intern (":ascent");
12117 staticpro (&QCascent);
12118 QCmargin = intern (":margin");
12119 staticpro (&QCmargin);
12120 QCrelief = intern (":relief");
12121 staticpro (&QCrelief);
fcf431dc
GM		 12122 Qpostscript = intern ("postscript");
12123 staticpro (&Qpostscript);
333b20bb
GM		 12124 QCloader = intern (":loader");
12125 staticpro (&QCloader);
12126 QCbounding_box = intern (":bounding-box");
12127 staticpro (&QCbounding_box);
12128 QCpt_width = intern (":pt-width");
12129 staticpro (&QCpt_width);
12130 QCpt_height = intern (":pt-height");
12131 staticpro (&QCpt_height);
3ccff1e3
GM		 12132 QCindex = intern (":index");
12133 staticpro (&QCindex);
333b20bb
GM		 12134 Qpbm = intern ("pbm");
12135 staticpro (&Qpbm);
12136
12137#if HAVE_XPM
12138 Qxpm = intern ("xpm");
12139 staticpro (&Qxpm);
12140#endif
12141
12142#if HAVE_JPEG
12143 Qjpeg = intern ("jpeg");
12144 staticpro (&Qjpeg);
12145#endif
12146
12147#if HAVE_TIFF
12148 Qtiff = intern ("tiff");
12149 staticpro (&Qtiff);
12150#endif
12151
12152#if HAVE_GIF
12153 Qgif = intern ("gif");
12154 staticpro (&Qgif);
12155#endif
12156
12157#if HAVE_PNG
12158 Qpng = intern ("png");
12159 staticpro (&Qpng);
12160#endif
12161
12162 defsubr (&Sclear_image_cache);
42677916 12163 defsubr (&Simage_size);
b243755a 12164 defsubr (&Simage_mask_p);
333b20bb 12165
0af913d7
GM		 12166 hourglass_atimer = NULL;
12167 hourglass_shown_p = 0;
333b20bb
GM		 12168
12169 defsubr (&Sx_show_tip);
12170 defsubr (&Sx_hide_tip);
333b20bb 12171 tip_timer = Qnil;
44b5a125
GM		 12172 staticpro (&tip_timer);
12173 tip_frame = Qnil;
12174 staticpro (&tip_frame);
333b20bb 12175
06d62053
GM		 12176 last_show_tip_args = Qnil;
12177 staticpro (&last_show_tip_args);
12178
333b20bb
GM		 12179#ifdef USE_MOTIF
12180 defsubr (&Sx_file_dialog);
12181#endif
12182}
12183
12184
12185void
12186init_xfns ()
12187{
12188 image_types = NULL;
12189 Vimage_types = Qnil;
12190
12191 define_image_type (&xbm_type);
12192 define_image_type (&gs_type);
12193 define_image_type (&pbm_type);
12194
12195#if HAVE_XPM
12196 define_image_type (&xpm_type);
12197#endif
12198
12199#if HAVE_JPEG
12200 define_image_type (&jpeg_type);
12201#endif
12202
12203#if HAVE_TIFF
12204 define_image_type (&tiff_type);
12205#endif
12206
12207#if HAVE_GIF
12208 define_image_type (&gif_type);
12209#endif
12210
12211#if HAVE_PNG
12212 define_image_type (&png_type);
12213#endif
01f1ba30
JB		 12214}
12215
12216#endif /* HAVE_X_WINDOWS */
Unnamed repository; edit this file 'description' to name the repository.