HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Trailing whitespace deleted.
[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
488dd4c4
JD		 68#ifdef USE_GTK
69#include "gtkutil.h"
70#endif
71
9ef48a9d
RS		 72#ifdef USE_X_TOOLKIT
73#include <X11/Shell.h>
74
398ffa92 75#ifndef USE_MOTIF
9ef48a9d
RS		 76#include <X11/Xaw/Paned.h>
77#include <X11/Xaw/Label.h>
398ffa92 78#endif /* USE_MOTIF */
9ef48a9d
RS		 79
80#ifdef USG
81#undef USG /* ####KLUDGE for Solaris 2.2 and up */
82#include <X11/Xos.h>
83#define USG
84#else
85#include <X11/Xos.h>
86#endif
87
88#include "widget.h"
89
90#include "../lwlib/lwlib.h"
91
333b20bb
GM		 92#ifdef USE_MOTIF
93#include <Xm/Xm.h>
94#include <Xm/DialogS.h>
95#include <Xm/FileSB.h>
96#endif
97
3b882b1d
RS		 98/* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
333b20bb 100
3b882b1d 101#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
6c32dd68 102#define HACK_EDITRES
b9dc4443 103extern void _XEditResCheckMessages ();
6c32dd68
PR		 104#endif /* R5 + Athena */
105
333b20bb
GM		 106/* Unique id counter for widgets created by the Lucid Widget Library. */
107
6c32dd68
PR		 108extern LWLIB_ID widget_id_tick;
109
e3881aa0 110#ifdef USE_LUCID
82c90203 111/* This is part of a kludge--see lwlib/xlwmenu.c. */
03e2c340 112extern XFontStruct *xlwmenu_default_font;
e3881aa0 113#endif
9ef48a9d 114
6bc20398 115extern void free_frame_menubar ();
d62c8769 116extern double atof ();
333b20bb 117
fc2cdd9a
GM		 118#ifdef USE_MOTIF
119
120/* LessTif/Motif version info. */
121
122static Lisp_Object Vmotif_version_string;
123
124#endif /* USE_MOTIF */
125
9ef48a9d
RS		 126#endif /* USE_X_TOOLKIT */
127
9d317b2c
RS		 128#ifdef HAVE_X11R4
129#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
130#else
131#define MAXREQUEST(dpy) ((dpy)->max_request_size)
132#endif
133
333b20bb
GM		 134/* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
135 it, and including `bitmaps/gray' more than once is a problem when
136 config.h defines `static' as an empty replacement string. */
137
138int gray_bitmap_width = gray_width;
139int gray_bitmap_height = gray_height;
62906360 140char *gray_bitmap_bits = gray_bits;
333b20bb 141
498e9ac3 142/* The name we're using in resource queries. Most often "emacs". */
333b20bb 143
d387c960 144Lisp_Object Vx_resource_name;
ac63d3d6 145
498e9ac3
RS		 146/* The application class we're using in resource queries.
147 Normally "Emacs". */
333b20bb 148
498e9ac3
RS		 149Lisp_Object Vx_resource_class;
150
0af913d7 151/* Non-zero means we're allowed to display an hourglass cursor. */
333b20bb 152
0af913d7 153int display_hourglass_p;
333b20bb 154
01f1ba30 155/* The background and shape of the mouse pointer, and shape when not
b9dc4443 156 over text or in the modeline. */
333b20bb 157
01f1ba30 158Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 159Lisp_Object Vx_hourglass_pointer_shape;
333b20bb 160
ca0ecbf5 161/* The shape when over mouse-sensitive text. */
333b20bb 162
ca0ecbf5 163Lisp_Object Vx_sensitive_text_pointer_shape;
01f1ba30 164
8fb4ec9c
GM		 165/* If non-nil, the pointer shape to indicate that windows can be
166 dragged horizontally. */
167
168Lisp_Object Vx_window_horizontal_drag_shape;
169
b9dc4443 170/* Color of chars displayed in cursor box. */
333b20bb 171
01f1ba30
JB		 172Lisp_Object Vx_cursor_fore_pixel;
173
b9dc4443 174/* Nonzero if using X. */
333b20bb 175
b9dc4443 176static int x_in_use;
01f1ba30 177
b9dc4443 178/* Non nil if no window manager is in use. */
333b20bb 179
01f1ba30
JB		 180Lisp_Object Vx_no_window_manager;
181
f1c7b5a6 182/* Search path for bitmap files. */
333b20bb 183
f1c7b5a6
RS		 184Lisp_Object Vx_bitmap_file_path;
185
942ea06d 186/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
333b20bb 187
942ea06d
KH		 188Lisp_Object Vx_pixel_size_width_font_regexp;
189
f9942c9e
JB		 190Lisp_Object Qauto_raise;
191Lisp_Object Qauto_lower;
f9942c9e
JB		 192Lisp_Object Qborder_color;
193Lisp_Object Qborder_width;
133cfefd 194extern Lisp_Object Qbox;
f9942c9e 195Lisp_Object Qcursor_color;
dbc4e1c1 196Lisp_Object Qcursor_type;
f9942c9e 197Lisp_Object Qgeometry;
f9942c9e
JB		 198Lisp_Object Qicon_left;
199Lisp_Object Qicon_top;
200Lisp_Object Qicon_type;
80534dd6 201Lisp_Object Qicon_name;
f9942c9e
JB		 202Lisp_Object Qinternal_border_width;
203Lisp_Object Qleft;
1ab3d87e 204Lisp_Object Qright;
f9942c9e 205Lisp_Object Qmouse_color;
baaed68e 206Lisp_Object Qnone;
2cbebefb 207Lisp_Object Qouter_window_id;
f9942c9e 208Lisp_Object Qparent_id;
4701395c 209Lisp_Object Qscroll_bar_width;
8af1d7ca 210Lisp_Object Qsuppress_icon;
333b20bb 211extern Lisp_Object Qtop;
01f1ba30 212Lisp_Object Qundefined_color;
a3c87d4e 213Lisp_Object Qvertical_scroll_bars;
49795535 214Lisp_Object Qvisibility;
f9942c9e 215Lisp_Object Qwindow_id;
f676886a 216Lisp_Object Qx_frame_parameter;
9ef48a9d 217Lisp_Object Qx_resource_name;
4fe1de12
RS		 218Lisp_Object Quser_position;
219Lisp_Object Quser_size;
0cafb359 220extern Lisp_Object Qdisplay;
333b20bb 221Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
7c7ff7f5 222Lisp_Object Qscreen_gamma, Qline_spacing, Qcenter;
ae782866 223Lisp_Object Qcompound_text, Qcancel_timer;
ea0a1f53 224Lisp_Object Qwait_for_wm;
49d41073
EZ		 225Lisp_Object Qfullscreen;
226Lisp_Object Qfullwidth;
227Lisp_Object Qfullheight;
228Lisp_Object Qfullboth;
01f1ba30 229
b9dc4443 230/* The below are defined in frame.c. */
333b20bb 231
baaed68e 232extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
c2304e02 233extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
9ea173e8 234extern Lisp_Object Qtool_bar_lines;
f9942c9e 235
01f1ba30
JB		 236extern Lisp_Object Vwindow_system_version;
237
a367641f 238Lisp_Object Qface_set_after_frame_default;
333b20bb 239
f1d2ce7f 240#if GLYPH_DEBUG
eaf1eea9
GM		 241int image_cache_refcount, dpyinfo_refcount;
242#endif
243
244
01f1ba30 245\f
11ae94fe 246/* Error if we are not connected to X. */
333b20bb 247
7fc9de26 248void
11ae94fe
RS		 249check_x ()
250{
b9dc4443 251 if (! x_in_use)
11ae94fe
RS		 252 error ("X windows are not in use or not initialized");
253}
254
1c59f5df
RS		 255/* Nonzero if we can use mouse menus.
256 You should not call this unless HAVE_MENUS is defined. */
75cc8ee5
RS		 257
258int
1c59f5df 259have_menus_p ()
75cc8ee5 260{
b9dc4443
RS		 261 return x_in_use;
262}
263
264/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
265 and checking validity for X. */
266
267FRAME_PTR
268check_x_frame (frame)
269 Lisp_Object frame;
270{
271 FRAME_PTR f;
272
273 if (NILP (frame))
0fe92f72 274 frame = selected_frame;
b7826503 275 CHECK_LIVE_FRAME (frame);
0fe92f72 276 f = XFRAME (frame);
b9dc4443 277 if (! FRAME_X_P (f))
1c59f5df 278 error ("Non-X frame used");
b9dc4443 279 return f;
75cc8ee5
RS		 280}
281
b9dc4443
RS		 282/* Let the user specify an X display with a frame.
283 nil stands for the selected frame--or, if that is not an X frame,
284 the first X display on the list. */
285
286static struct x_display_info *
287check_x_display_info (frame)
288 Lisp_Object frame;
289{
8ec8a5ec 290 struct x_display_info *dpyinfo = NULL;
488dd4c4 291
b9dc4443
RS		 292 if (NILP (frame))
293 {
0fe92f72 294 struct frame *sf = XFRAME (selected_frame);
488dd4c4 295
0fe92f72 296 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
8ec8a5ec 297 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
b9dc4443 298 else if (x_display_list != 0)
8ec8a5ec 299 dpyinfo = x_display_list;
b9dc4443
RS		 300 else
301 error ("X windows are not in use or not initialized");
302 }
303 else if (STRINGP (frame))
8ec8a5ec 304 dpyinfo = x_display_info_for_name (frame);
b9dc4443
RS		 305 else
306 {
ba4c10fd 307 FRAME_PTR f = check_x_frame (frame);
8ec8a5ec 308 dpyinfo = FRAME_X_DISPLAY_INFO (f);
b9dc4443 309 }
8ec8a5ec
GM		 310
311 return dpyinfo;
b9dc4443 312}
333b20bb 313
b9dc4443 314\f
f676886a
JB		 315/* Return the Emacs frame-object corresponding to an X window.
316 It could be the frame's main window or an icon window. */
01f1ba30 317
34ca5317 318/* This function can be called during GC, so use GC_xxx type test macros. */
bcb2db92 319
f676886a 320struct frame *
2d271e2e
KH		 321x_window_to_frame (dpyinfo, wdesc)
322 struct x_display_info *dpyinfo;
01f1ba30
JB		 323 int wdesc;
324{
f676886a
JB		 325 Lisp_Object tail, frame;
326 struct frame *f;
01f1ba30 327
8e713be6 328 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
01f1ba30 329 {
8e713be6 330 frame = XCAR (tail);
34ca5317 331 if (!GC_FRAMEP (frame))
01f1ba30 332 continue;
f676886a 333 f = XFRAME (frame);
2d764c78 334 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
2d271e2e 335 continue;
0af913d7 336 if (f->output_data.x->hourglass_window == wdesc)
17cbbf95 337 return f;
9ef48a9d 338#ifdef USE_X_TOOLKIT
488dd4c4 339 if ((f->output_data.x->edit_widget
7556890b 340 && XtWindow (f->output_data.x->edit_widget) == wdesc)
333b20bb
GM		 341 /* A tooltip frame? */
342 || (!f->output_data.x->edit_widget
343 && FRAME_X_WINDOW (f) == wdesc)
7556890b 344 || f->output_data.x->icon_desc == wdesc)
9ef48a9d
RS		 345 return f;
346#else /* not USE_X_TOOLKIT */
488dd4c4
JD		 347#ifdef USE_GTK
348 if (f->output_data.x->edit_widget)
349 {
350 GtkWidget *gwdesc = xg_win_to_widget (wdesc);
351 struct x_output *x = f->output_data.x;
352 if (gwdesc != 0 && gwdesc == x->edit_widget)
353 return f;
354 }
355#endif /* USE_GTK */
fe24a618 356 if (FRAME_X_WINDOW (f) == wdesc
7556890b 357 || f->output_data.x->icon_desc == wdesc)
f676886a 358 return f;
9ef48a9d
RS		 359#endif /* not USE_X_TOOLKIT */
360 }
361 return 0;
362}
363
488dd4c4 364#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
9ef48a9d
RS		 365/* Like x_window_to_frame but also compares the window with the widget's
366 windows. */
367
368struct frame *
2d271e2e
KH		 369x_any_window_to_frame (dpyinfo, wdesc)
370 struct x_display_info *dpyinfo;
9ef48a9d
RS		 371 int wdesc;
372{
373 Lisp_Object tail, frame;
17cbbf95 374 struct frame *f, *found;
7556890b 375 struct x_output *x;
9ef48a9d 376
17cbbf95
GM		 377 found = NULL;
378 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
9ef48a9d 379 {
8e713be6 380 frame = XCAR (tail);
34ca5317 381 if (!GC_FRAMEP (frame))
9ef48a9d 382 continue;
488dd4c4 383
9ef48a9d 384 f = XFRAME (frame);
17cbbf95 385 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
333b20bb 386 {
17cbbf95
GM		 387 /* This frame matches if the window is any of its widgets. */
388 x = f->output_data.x;
0af913d7 389 if (x->hourglass_window == wdesc)
17cbbf95
GM		 390 found = f;
391 else if (x->widget)
392 {
488dd4c4
JD		 393#ifdef USE_GTK
394 GtkWidget *gwdesc = xg_win_to_widget (wdesc);
395 if (gwdesc != 0
396 && (gwdesc == x->widget
397 || gwdesc == x->edit_widget
398 || gwdesc == x->vbox_widget
399 || gwdesc == x->menubar_widget))
400 found = f;
401#else
402 if (wdesc == XtWindow (x->widget)
403 || wdesc == XtWindow (x->column_widget)
17cbbf95
GM		 404 || wdesc == XtWindow (x->edit_widget))
405 found = f;
406 /* Match if the window is this frame's menubar. */
407 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
408 found = f;
488dd4c4 409#endif
17cbbf95
GM		 410 }
411 else if (FRAME_X_WINDOW (f) == wdesc)
412 /* A tooltip frame. */
413 found = f;
333b20bb 414 }
01f1ba30 415 }
488dd4c4 416
17cbbf95 417 return found;
01f1ba30 418}
5e65b9ab 419
5fbc3f3a
KH		 420/* Likewise, but exclude the menu bar widget. */
421
422struct frame *
423x_non_menubar_window_to_frame (dpyinfo, wdesc)
424 struct x_display_info *dpyinfo;
425 int wdesc;
426{
427 Lisp_Object tail, frame;
428 struct frame *f;
7556890b 429 struct x_output *x;
5fbc3f3a 430
8e713be6 431 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
5fbc3f3a 432 {
8e713be6 433 frame = XCAR (tail);
5fbc3f3a
KH		 434 if (!GC_FRAMEP (frame))
435 continue;
436 f = XFRAME (frame);
2d764c78 437 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
5fbc3f3a 438 continue;
7556890b 439 x = f->output_data.x;
5fbc3f3a 440 /* This frame matches if the window is any of its widgets. */
0af913d7 441 if (x->hourglass_window == wdesc)
17cbbf95
GM		 442 return f;
443 else if (x->widget)
333b20bb 444 {
488dd4c4
JD		 445#ifdef USE_GTK
446 GtkWidget *gwdesc = xg_win_to_widget (wdesc);
447 if (gwdesc != 0
448 && (gwdesc == x->widget
449 || gwdesc == x->edit_widget
450 || gwdesc == x->vbox_widget))
451 return f;
452#else
453 if (wdesc == XtWindow (x->widget)
454 || wdesc == XtWindow (x->column_widget)
333b20bb
GM		 455 || wdesc == XtWindow (x->edit_widget))
456 return f;
488dd4c4 457#endif
333b20bb
GM		 458 }
459 else if (FRAME_X_WINDOW (f) == wdesc)
460 /* A tooltip frame. */
5fbc3f3a
KH		 461 return f;
462 }
463 return 0;
464}
465
fd3a3022
RS		 466/* Likewise, but consider only the menu bar widget. */
467
468struct frame *
469x_menubar_window_to_frame (dpyinfo, wdesc)
470 struct x_display_info *dpyinfo;
471 int wdesc;
472{
473 Lisp_Object tail, frame;
474 struct frame *f;
7556890b 475 struct x_output *x;
fd3a3022 476
8e713be6 477 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
fd3a3022 478 {
8e713be6 479 frame = XCAR (tail);
fd3a3022
RS		 480 if (!GC_FRAMEP (frame))
481 continue;
482 f = XFRAME (frame);
2d764c78 483 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
fd3a3022 484 continue;
7556890b 485 x = f->output_data.x;
fd3a3022 486 /* Match if the window is this frame's menubar. */
488dd4c4
JD		 487#ifdef USE_GTK
488 if (x->menubar_widget)
489 {
490 GtkWidget *gwdesc = xg_win_to_widget (wdesc);
491 int found = 0;
492
493 BLOCK_INPUT;
494 if (gwdesc != 0
495 && (gwdesc == x->menubar_widget
496 || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
497 found = 1;
498 UNBLOCK_INPUT;
499 if (found) return f;
500 }
501#else
333b20bb
GM		 502 if (x->menubar_widget
503 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
fd3a3022 504 return f;
488dd4c4 505#endif
fd3a3022
RS		 506 }
507 return 0;
508}
509
5e65b9ab
RS		 510/* Return the frame whose principal (outermost) window is WDESC.
511 If WDESC is some other (smaller) window, we return 0. */
512
513struct frame *
2d271e2e
KH		 514x_top_window_to_frame (dpyinfo, wdesc)
515 struct x_display_info *dpyinfo;
5e65b9ab
RS		 516 int wdesc;
517{
518 Lisp_Object tail, frame;
519 struct frame *f;
7556890b 520 struct x_output *x;
5e65b9ab 521
8e713be6 522 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
5e65b9ab 523 {
8e713be6 524 frame = XCAR (tail);
34ca5317 525 if (!GC_FRAMEP (frame))
5e65b9ab
RS		 526 continue;
527 f = XFRAME (frame);
2d764c78 528 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
2d271e2e 529 continue;
7556890b 530 x = f->output_data.x;
333b20bb
GM		 531
532 if (x->widget)
533 {
534 /* This frame matches if the window is its topmost widget. */
488dd4c4
JD		 535#ifdef USE_GTK
536 GtkWidget *gwdesc = xg_win_to_widget (wdesc);
537 if (gwdesc == x->widget)
538 return f;
539#else
333b20bb
GM		 540 if (wdesc == XtWindow (x->widget))
541 return f;
7a994728
KH		 542#if 0 /* I don't know why it did this,
543 but it seems logically wrong,
544 and it causes trouble for MapNotify events. */
333b20bb 545 /* Match if the window is this frame's menubar. */
488dd4c4 546 if (x->menubar_widget
333b20bb
GM		 547 && wdesc == XtWindow (x->menubar_widget))
548 return f;
488dd4c4 549#endif
7a994728 550#endif
333b20bb
GM		 551 }
552 else if (FRAME_X_WINDOW (f) == wdesc)
553 /* Tooltip frame. */
554 return f;
5e65b9ab
RS		 555 }
556 return 0;
557}
488dd4c4 558#endif /* USE_X_TOOLKIT || USE_GTK */
01f1ba30 559
01f1ba30 560\f
203c1d73
RS		 561
562/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
563 id, which is just an int that this section returns. Bitmaps are
564 reference counted so they can be shared among frames.
565
566 Bitmap indices are guaranteed to be > 0, so a negative number can
567 be used to indicate no bitmap.
568
569 If you use x_create_bitmap_from_data, then you must keep track of
570 the bitmaps yourself. That is, creating a bitmap from the same
b9dc4443 571 data more than once will not be caught. */
203c1d73
RS		 572
573
f1c7b5a6
RS		 574/* Functions to access the contents of a bitmap, given an id. */
575
576int
577x_bitmap_height (f, id)
578 FRAME_PTR f;
579 int id;
580{
08a90d6a 581 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
f1c7b5a6
RS		 582}
583
584int
585x_bitmap_width (f, id)
586 FRAME_PTR f;
587 int id;
588{
08a90d6a 589 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
f1c7b5a6
RS		 590}
591
592int
593x_bitmap_pixmap (f, id)
594 FRAME_PTR f;
595 int id;
596{
08a90d6a 597 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
f1c7b5a6
RS		 598}
599
600
203c1d73
RS		 601/* Allocate a new bitmap record. Returns index of new record. */
602
603static int
08a90d6a
RS		 604x_allocate_bitmap_record (f)
605 FRAME_PTR f;
203c1d73 606{
08a90d6a
RS		 607 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
608 int i;
609
610 if (dpyinfo->bitmaps == NULL)
203c1d73 611 {
08a90d6a
RS		 612 dpyinfo->bitmaps_size = 10;
613 dpyinfo->bitmaps
614 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
615 dpyinfo->bitmaps_last = 1;
203c1d73
RS		 616 return 1;
617 }
618
08a90d6a
RS		 619 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
620 return ++dpyinfo->bitmaps_last;
203c1d73 621
08a90d6a
RS		 622 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
623 if (dpyinfo->bitmaps[i].refcount == 0)
624 return i + 1;
203c1d73 625
08a90d6a
RS		 626 dpyinfo->bitmaps_size *= 2;
627 dpyinfo->bitmaps
628 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
629 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
630 return ++dpyinfo->bitmaps_last;
203c1d73
RS		 631}
632
633/* Add one reference to the reference count of the bitmap with id ID. */
634
635void
f1c7b5a6
RS		 636x_reference_bitmap (f, id)
637 FRAME_PTR f;
203c1d73
RS		 638 int id;
639{
08a90d6a 640 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
203c1d73
RS		 641}
642
643/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
644
645int
646x_create_bitmap_from_data (f, bits, width, height)
647 struct frame *f;
648 char *bits;
649 unsigned int width, height;
650{
08a90d6a 651 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
203c1d73
RS		 652 Pixmap bitmap;
653 int id;
654
b9dc4443 655 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
203c1d73
RS		 656 bits, width, height);
657
658 if (! bitmap)
659 return -1;
660
08a90d6a
RS		 661 id = x_allocate_bitmap_record (f);
662 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
663 dpyinfo->bitmaps[id - 1].file = NULL;
664 dpyinfo->bitmaps[id - 1].refcount = 1;
665 dpyinfo->bitmaps[id - 1].depth = 1;
666 dpyinfo->bitmaps[id - 1].height = height;
667 dpyinfo->bitmaps[id - 1].width = width;
203c1d73
RS		 668
669 return id;
670}
671
672/* Create bitmap from file FILE for frame F. */
673
674int
675x_create_bitmap_from_file (f, file)
676 struct frame *f;
f1c7b5a6 677 Lisp_Object file;
203c1d73 678{
08a90d6a 679 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
203c1d73
RS		 680 unsigned int width, height;
681 Pixmap bitmap;
682 int xhot, yhot, result, id;
f1c7b5a6
RS		 683 Lisp_Object found;
684 int fd;
685 char *filename;
203c1d73
RS		 686
687 /* Look for an existing bitmap with the same name. */
08a90d6a 688 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
203c1d73 689 {
08a90d6a
RS		 690 if (dpyinfo->bitmaps[id].refcount
691 && dpyinfo->bitmaps[id].file
d5db4077 692 && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
203c1d73 693 {
08a90d6a 694 ++dpyinfo->bitmaps[id].refcount;
203c1d73
RS		 695 return id + 1;
696 }
697 }
698
f1c7b5a6 699 /* Search bitmap-file-path for the file, if appropriate. */
de2413e9 700 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
f1c7b5a6
RS		 701 if (fd < 0)
702 return -1;
68c45bf0 703 emacs_close (fd);
f1c7b5a6 704
d5db4077 705 filename = (char *) SDATA (found);
f1c7b5a6 706
b9dc4443 707 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f1c7b5a6 708 filename, &width, &height, &bitmap, &xhot, &yhot);
203c1d73
RS		 709 if (result != BitmapSuccess)
710 return -1;
711
08a90d6a
RS		 712 id = x_allocate_bitmap_record (f);
713 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
714 dpyinfo->bitmaps[id - 1].refcount = 1;
9f2a85b2 715 dpyinfo->bitmaps[id - 1].file
d5db4077 716 = (char *) xmalloc (SBYTES (file) + 1);
08a90d6a
RS		 717 dpyinfo->bitmaps[id - 1].depth = 1;
718 dpyinfo->bitmaps[id - 1].height = height;
719 dpyinfo->bitmaps[id - 1].width = width;
d5db4077 720 strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
203c1d73
RS		 721
722 return id;
723}
724
725/* Remove reference to bitmap with id number ID. */
726
968b1234 727void
f1c7b5a6
RS		 728x_destroy_bitmap (f, id)
729 FRAME_PTR f;
203c1d73
RS		 730 int id;
731{
08a90d6a
RS		 732 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
733
203c1d73
RS		 734 if (id > 0)
735 {
08a90d6a
RS		 736 --dpyinfo->bitmaps[id - 1].refcount;
737 if (dpyinfo->bitmaps[id - 1].refcount == 0)
203c1d73 738 {
ed662bdd 739 BLOCK_INPUT;
08a90d6a
RS		 740 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
741 if (dpyinfo->bitmaps[id - 1].file)
203c1d73 742 {
333b20bb 743 xfree (dpyinfo->bitmaps[id - 1].file);
08a90d6a 744 dpyinfo->bitmaps[id - 1].file = NULL;
203c1d73 745 }
ed662bdd 746 UNBLOCK_INPUT;
203c1d73
RS		 747 }
748 }
749}
750
08a90d6a 751/* Free all the bitmaps for the display specified by DPYINFO. */
203c1d73 752
08a90d6a
RS		 753static void
754x_destroy_all_bitmaps (dpyinfo)
755 struct x_display_info *dpyinfo;
203c1d73 756{
08a90d6a
RS		 757 int i;
758 for (i = 0; i < dpyinfo->bitmaps_last; i++)
759 if (dpyinfo->bitmaps[i].refcount > 0)
760 {
761 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
762 if (dpyinfo->bitmaps[i].file)
333b20bb 763 xfree (dpyinfo->bitmaps[i].file);
08a90d6a
RS		 764 }
765 dpyinfo->bitmaps_last = 0;
203c1d73
RS		 766}
767\f
f676886a 768/* Connect the frame-parameter names for X frames
01f1ba30
JB		 769 to the ways of passing the parameter values to the window system.
770
771 The name of a parameter, as a Lisp symbol,
f676886a 772 has an `x-frame-parameter' property which is an integer in Lisp
9fb026ab 773 that is an index in this table. */
01f1ba30 774
f676886a 775struct x_frame_parm_table
01f1ba30
JB		 776{
777 char *name;
d62c8769 778 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
01f1ba30
JB		 779};
780
eaf1eea9
GM		 781static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
782static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
52de7ce9 783static void x_change_window_heights P_ ((Lisp_Object, int));
14819cb3 784static void x_disable_image P_ ((struct frame *, struct image *));
d62c8769 785void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
563b67aa 786static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
ea0a1f53 787static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
49d41073 788static void x_set_fullscreen P_ ((struct frame *, Lisp_Object, Lisp_Object));
d62c8769
GM		 789void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
790void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
791void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
792void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
793void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
794void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
795void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
b3ba0aa8 796static void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
d62c8769
GM		 797void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
798void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
799void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
800 Lisp_Object));
801void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
802void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
803void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
804void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
805 Lisp_Object));
806void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
807void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
808void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
809void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
810void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
9ea173e8 811void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
333b20bb
GM		 812void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
813 Lisp_Object));
814void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
815 Lisp_Object));
816static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
817 Lisp_Object,
818 Lisp_Object,
819 char *, char *,
820 int));
d62c8769 821static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
4a8e312c
GM		 822static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
823 Lisp_Object));
b243755a
GM		 824static void init_color_table P_ ((void));
825static void free_color_table P_ ((void));
826static unsigned long *colors_in_color_table P_ ((int *n));
827static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
828static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
829
830
01f1ba30 831
f676886a 832static struct x_frame_parm_table x_frame_parms[] =
01f1ba30 833{
9908a324
PJ		 834 {"auto-raise", x_set_autoraise},
835 {"auto-lower", x_set_autolower},
836 {"background-color", x_set_background_color},
837 {"border-color", x_set_border_color},
838 {"border-width", x_set_border_width},
839 {"cursor-color", x_set_cursor_color},
840 {"cursor-type", x_set_cursor_type},
841 {"font", x_set_font},
842 {"foreground-color", x_set_foreground_color},
843 {"icon-name", x_set_icon_name},
844 {"icon-type", x_set_icon_type},
845 {"internal-border-width", x_set_internal_border_width},
846 {"menu-bar-lines", x_set_menu_bar_lines},
847 {"mouse-color", x_set_mouse_color},
848 {"name", x_explicitly_set_name},
849 {"scroll-bar-width", x_set_scroll_bar_width},
850 {"title", x_set_title},
851 {"unsplittable", x_set_unsplittable},
852 {"vertical-scroll-bars", x_set_vertical_scroll_bars},
853 {"visibility", x_set_visibility},
854 {"tool-bar-lines", x_set_tool_bar_lines},
855 {"scroll-bar-foreground", x_set_scroll_bar_foreground},
856 {"scroll-bar-background", x_set_scroll_bar_background},
857 {"screen-gamma", x_set_screen_gamma},
858 {"line-spacing", x_set_line_spacing},
859 {"left-fringe", x_set_fringe_width},
860 {"right-fringe", x_set_fringe_width},
49d41073
EZ		 861 {"wait-for-wm", x_set_wait_for_wm},
862 {"fullscreen", x_set_fullscreen},
488dd4c4 863
01f1ba30
JB		 864};
865
f676886a 866/* Attach the `x-frame-parameter' properties to
01f1ba30
JB		 867 the Lisp symbol names of parameters relevant to X. */
868
201d8c78 869void
01f1ba30
JB		 870init_x_parm_symbols ()
871{
872 int i;
873
d043f1a4 874 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
f676886a 875 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
01f1ba30
JB		 876 make_number (i));
877}
878\f
49d41073
EZ		 879
880/* Really try to move where we want to be in case of fullscreen. Some WMs
881 moves the window where we tell them. Some (mwm, twm) moves the outer
882 window manager window there instead.
883 Try to compensate for those WM here. */
884static void
885x_fullscreen_move (f, new_top, new_left)
886 struct frame *f;
887 int new_top;
888 int new_left;
889{
890 if (new_top != f->output_data.x->top_pos
891 || new_left != f->output_data.x->left_pos)
892 {
893 int move_x = new_left + f->output_data.x->x_pixels_outer_diff;
894 int move_y = new_top + f->output_data.x->y_pixels_outer_diff;
895
896 f->output_data.x->want_fullscreen |= FULLSCREEN_MOVE_WAIT;
897 x_set_offset (f, move_x, move_y, 1);
898 }
899}
900
e8cc313b 901/* Change the parameters of frame F as specified by ALIST.
64362cd4
GM		 902 If a parameter is not specially recognized, do nothing special;
903 otherwise call the `x_set_...' function for that parameter.
904 Except for certain geometry properties, always call store_frame_param
905 to store the new value in the parameter alist. */
d043f1a4 906
f9942c9e
JB		 907void
908x_set_frame_parameters (f, alist)
909 FRAME_PTR f;
910 Lisp_Object alist;
911{
912 Lisp_Object tail;
913
914 /* If both of these parameters are present, it's more efficient to
915 set them both at once. So we wait until we've looked at the
916 entire list before we set them. */
e4f79258 917 int width, height;
f9942c9e
JB		 918
919 /* Same here. */
920 Lisp_Object left, top;
f9942c9e 921
a59e4f3d
RS		 922 /* Same with these. */
923 Lisp_Object icon_left, icon_top;
924
f5e70acd
RS		 925 /* Record in these vectors all the parms specified. */
926 Lisp_Object *parms;
927 Lisp_Object *values;
a797a73d 928 int i, p;
e1d962d7 929 int left_no_change = 0, top_no_change = 0;
a59e4f3d 930 int icon_left_no_change = 0, icon_top_no_change = 0;
5f9338d5 931 int fullscreen_is_being_set = 0;
203c1d73 932
7589a1d9
RS		 933 struct gcpro gcpro1, gcpro2;
934
f5e70acd
RS		 935 i = 0;
936 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
937 i++;
938
939 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
940 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
f9942c9e 941
f5e70acd
RS		 942 /* Extract parm names and values into those vectors. */
943
944 i = 0;
f9942c9e
JB		 945 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
946 {
333b20bb 947 Lisp_Object elt;
f9942c9e
JB		 948
949 elt = Fcar (tail);
f5e70acd
RS		 950 parms[i] = Fcar (elt);
951 values[i] = Fcdr (elt);
952 i++;
953 }
7589a1d9
RS		 954 /* TAIL and ALIST are not used again below here. */
955 alist = tail = Qnil;
956
957 GCPRO2 (*parms, *values);
958 gcpro1.nvars = i;
959 gcpro2.nvars = i;
f5e70acd 960
7589a1d9
RS		 961 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
962 because their values appear in VALUES and strings are not valid. */
e4f79258 963 top = left = Qunbound;
a59e4f3d 964 icon_left = icon_top = Qunbound;
f9942c9e 965
e4f79258
RS		 966 /* Provide default values for HEIGHT and WIDTH. */
967 if (FRAME_NEW_WIDTH (f))
968 width = FRAME_NEW_WIDTH (f);
969 else
970 width = FRAME_WIDTH (f);
971
972 if (FRAME_NEW_HEIGHT (f))
973 height = FRAME_NEW_HEIGHT (f);
974 else
975 height = FRAME_HEIGHT (f);
976
a797a73d
GV		 977 /* Process foreground_color and background_color before anything else.
978 They are independent of other properties, but other properties (e.g.,
979 cursor_color) are dependent upon them. */
b3ba0aa8 980 /* Process default font as well, since fringe widths depends on it. */
49d41073 981 /* Also, process fullscreen, width and height depend upon that */
488dd4c4 982 for (p = 0; p < i; p++)
a797a73d
GV		 983 {
984 Lisp_Object prop, val;
985
986 prop = parms[p];
987 val = values[p];
b3ba0aa8
KS		 988 if (EQ (prop, Qforeground_color)
989 || EQ (prop, Qbackground_color)
49d41073
EZ		 990 || EQ (prop, Qfont)
991 || EQ (prop, Qfullscreen))
a797a73d
GV		 992 {
993 register Lisp_Object param_index, old_value;
994
a797a73d 995 old_value = get_frame_param (f, prop);
f0b9a067 996 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
488dd4c4 997
c7e609d5
MB		 998 if (NILP (Fequal (val, old_value)))
999 {
1000 store_frame_param (f, prop, val);
1001
1002 param_index = Fget (prop, Qx_frame_parameter);
1003 if (NATNUMP (param_index)
1004 && (XFASTINT (param_index)
1005 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
1006 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
1007 }
a797a73d
GV		 1008 }
1009 }
1010
f5e70acd
RS		 1011 /* Now process them in reverse of specified order. */
1012 for (i--; i >= 0; i--)
1013 {
1014 Lisp_Object prop, val;
1015
1016 prop = parms[i];
1017 val = values[i];
1018
e4f79258
RS		 1019 if (EQ (prop, Qwidth) && NUMBERP (val))
1020 width = XFASTINT (val);
1021 else if (EQ (prop, Qheight) && NUMBERP (val))
1022 height = XFASTINT (val);
f5e70acd 1023 else if (EQ (prop, Qtop))
f9942c9e 1024 top = val;
f5e70acd 1025 else if (EQ (prop, Qleft))
f9942c9e 1026 left = val;
a59e4f3d
RS		 1027 else if (EQ (prop, Qicon_top))
1028 icon_top = val;
1029 else if (EQ (prop, Qicon_left))
1030 icon_left = val;
b3ba0aa8
KS		 1031 else if (EQ (prop, Qforeground_color)
1032 || EQ (prop, Qbackground_color)
49d41073
EZ		 1033 || EQ (prop, Qfont)
1034 || EQ (prop, Qfullscreen))
a797a73d
GV		 1035 /* Processed above. */
1036 continue;
f9942c9e
JB		 1037 else
1038 {
98381190 1039 register Lisp_Object param_index, old_value;
ea96210c 1040
98381190 1041 old_value = get_frame_param (f, prop);
c7e609d5 1042
9f7e52b4 1043 store_frame_param (f, prop, val);
c7e609d5 1044
9f7e52b4
GM		 1045 param_index = Fget (prop, Qx_frame_parameter);
1046 if (NATNUMP (param_index)
1047 && (XFASTINT (param_index)
1048 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
1049 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
f9942c9e
JB		 1050 }
1051 }
1052
11378c41
RS		 1053 /* Don't die if just one of these was set. */
1054 if (EQ (left, Qunbound))
e1d962d7
RS		 1055 {
1056 left_no_change = 1;
7556890b
RS		 1057 if (f->output_data.x->left_pos < 0)
1058 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
e1d962d7 1059 else
7556890b 1060 XSETINT (left, f->output_data.x->left_pos);
e1d962d7 1061 }
11378c41 1062 if (EQ (top, Qunbound))
e1d962d7
RS		 1063 {
1064 top_no_change = 1;
7556890b
RS		 1065 if (f->output_data.x->top_pos < 0)
1066 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
e1d962d7 1067 else
7556890b 1068 XSETINT (top, f->output_data.x->top_pos);
e1d962d7 1069 }
11378c41 1070
a59e4f3d
RS		 1071 /* If one of the icon positions was not set, preserve or default it. */
1072 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
1073 {
1074 icon_left_no_change = 1;
1075 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
1076 if (NILP (icon_left))
1077 XSETINT (icon_left, 0);
1078 }
1079 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
1080 {
1081 icon_top_no_change = 1;
1082 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
1083 if (NILP (icon_top))
1084 XSETINT (icon_top, 0);
1085 }
1086
5f9338d5 1087 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
49d41073
EZ		 1088 {
1089 /* If the frame is visible already and the fullscreen parameter is
1090 being set, it is too late to set WM manager hints to specify
1091 size and position.
1092 Here we first get the width, height and position that applies to
1093 fullscreen. We then move the frame to the appropriate
1094 position. Resize of the frame is taken care of in the code after
5f9338d5 1095 this if-statement. */
49d41073 1096 int new_left, new_top;
488dd4c4 1097
49d41073
EZ		 1098 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
1099 x_fullscreen_move (f, new_top, new_left);
1100 }
488dd4c4 1101
499ea23b 1102 /* Don't set these parameters unless they've been explicitly
d387c960
JB		 1103 specified. The window might be mapped or resized while we're in
1104 this function, and we don't want to override that unless the lisp
1105 code has asked for it.
1106
1107 Don't set these parameters unless they actually differ from the
1108 window's current parameters; the window may not actually exist
1109 yet. */
f9942c9e
JB		 1110 {
1111 Lisp_Object frame;
1112
1f11a5ca
RS		 1113 check_frame_size (f, &height, &width);
1114
191ed777 1115 XSETFRAME (frame, f);
11378c41 1116
e4f79258
RS		 1117 if (width != FRAME_WIDTH (f)
1118 || height != FRAME_HEIGHT (f)
d6f80ae9 1119 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
e4f79258 1120 Fset_frame_size (frame, make_number (width), make_number (height));
f10f0b79
RS		 1121
1122 if ((!NILP (left) || !NILP (top))
e1d962d7 1123 && ! (left_no_change && top_no_change)
7556890b
RS		 1124 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
1125 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
f10f0b79 1126 {
e1d962d7
RS		 1127 int leftpos = 0;
1128 int toppos = 0;
f10f0b79
RS		 1129
1130 /* Record the signs. */
7556890b 1131 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
e1d962d7 1132 if (EQ (left, Qminus))
7556890b 1133 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7
RS		 1134 else if (INTEGERP (left))
1135 {
1136 leftpos = XINT (left);
1137 if (leftpos < 0)
7556890b 1138 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7 1139 }
8e713be6
KR		 1140 else if (CONSP (left) && EQ (XCAR (left), Qminus)
1141 && CONSP (XCDR (left))
1142 && INTEGERP (XCAR (XCDR (left))))
e1d962d7 1143 {
8e713be6 1144 leftpos = - XINT (XCAR (XCDR (left)));
7556890b 1145 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7 1146 }
8e713be6
KR		 1147 else if (CONSP (left) && EQ (XCAR (left), Qplus)
1148 && CONSP (XCDR (left))
1149 && INTEGERP (XCAR (XCDR (left))))
e1d962d7 1150 {
8e713be6 1151 leftpos = XINT (XCAR (XCDR (left)));
e1d962d7
RS		 1152 }
1153
1154 if (EQ (top, Qminus))
7556890b 1155 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7
RS		 1156 else if (INTEGERP (top))
1157 {
1158 toppos = XINT (top);
1159 if (toppos < 0)
7556890b 1160 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7 1161 }
8e713be6
KR		 1162 else if (CONSP (top) && EQ (XCAR (top), Qminus)
1163 && CONSP (XCDR (top))
1164 && INTEGERP (XCAR (XCDR (top))))
e1d962d7 1165 {
8e713be6 1166 toppos = - XINT (XCAR (XCDR (top)));
7556890b 1167 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7 1168 }
8e713be6
KR		 1169 else if (CONSP (top) && EQ (XCAR (top), Qplus)
1170 && CONSP (XCDR (top))
1171 && INTEGERP (XCAR (XCDR (top))))
e1d962d7 1172 {
8e713be6 1173 toppos = XINT (XCAR (XCDR (top)));
e1d962d7
RS		 1174 }
1175
1176
1177 /* Store the numeric value of the position. */
7556890b
RS		 1178 f->output_data.x->top_pos = toppos;
1179 f->output_data.x->left_pos = leftpos;
e1d962d7 1180
7556890b 1181 f->output_data.x->win_gravity = NorthWestGravity;
f10f0b79
RS		 1182
1183 /* Actually set that position, and convert to absolute. */
f0e72e79 1184 x_set_offset (f, leftpos, toppos, -1);
f10f0b79 1185 }
a59e4f3d
RS		 1186
1187 if ((!NILP (icon_left) || !NILP (icon_top))
1188 && ! (icon_left_no_change && icon_top_no_change))
1189 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
f9942c9e 1190 }
7589a1d9
RS		 1191
1192 UNGCPRO;
f9942c9e 1193}
01f1ba30 1194
08a90d6a 1195/* Store the screen positions of frame F into XPTR and YPTR.
e9445337
RS		 1196 These are the positions of the containing window manager window,
1197 not Emacs's own window. */
1198
1199void
1200x_real_positions (f, xptr, yptr)
1201 FRAME_PTR f;
1202 int *xptr, *yptr;
1203{
49d41073
EZ		 1204 int win_x, win_y, outer_x, outer_y;
1205 int real_x = 0, real_y = 0;
1206 int had_errors = 0;
1207 Window win = f->output_data.x->parent_desc;
e9445337 1208
49d41073 1209 int count;
043835a3 1210
49d41073
EZ		 1211 BLOCK_INPUT;
1212
1213 count = x_catch_errors (FRAME_X_DISPLAY (f));
043835a3 1214
49d41073
EZ		 1215 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
1216 win = FRAME_OUTER_WINDOW (f);
1217
1218 /* This loop traverses up the containment tree until we hit the root
1219 window. Window managers may intersect many windows between our window
1220 and the root window. The window we find just before the root window
1221 should be the outer WM window. */
1222 for (;;)
e9445337 1223 {
49d41073
EZ		 1224 Window wm_window, rootw;
1225 Window *tmp_children;
1226 unsigned int tmp_nchildren;
e7161ad9 1227 int success;
ca7bac79 1228
e7161ad9
RS		 1229 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
1230 &wm_window, &tmp_children, &tmp_nchildren);
08a90d6a 1231
49d41073 1232 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
08a90d6a 1233
e7161ad9
RS		 1234 /* Don't free tmp_children if XQueryTree failed. */
1235 if (! success)
1236 break;
1237
1238 XFree ((char *) tmp_children);
1239
49d41073
EZ		 1240 if (wm_window == rootw || had_errors)
1241 break;
08a90d6a 1242
49d41073
EZ		 1243 win = wm_window;
1244 }
488dd4c4 1245
49d41073
EZ		 1246 if (! had_errors)
1247 {
1248 int ign;
1249 Window child, rootw;
488dd4c4 1250
49d41073
EZ		 1251 /* Get the real coordinates for the WM window upper left corner */
1252 XGetGeometry (FRAME_X_DISPLAY (f), win,
1253 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
1254
1255 /* Translate real coordinates to coordinates relative to our
1256 window. For our window, the upper left corner is 0, 0.
1257 Since the upper left corner of the WM window is outside
1258 our window, win_x and win_y will be negative:
1259
1260 ------------------ ---> x
1261 | title |
1262 | ----------------- v y
1263 | | our window
1264 */
8a07bba0 1265 XTranslateCoordinates (FRAME_X_DISPLAY (f),
e9445337 1266
8a07bba0 1267 /* From-window, to-window. */
8a07bba0 1268 FRAME_X_DISPLAY_INFO (f)->root_window,
49d41073 1269 FRAME_X_WINDOW (f),
e9445337 1270
8a07bba0 1271 /* From-position, to-position. */
49d41073 1272 real_x, real_y, &win_x, &win_y,
08a90d6a 1273
8a07bba0
RS		 1274 /* Child of win. */
1275 &child);
e9445337 1276
49d41073 1277 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
845e9d85 1278 {
49d41073
EZ		 1279 outer_x = win_x;
1280 outer_y = win_y;
845e9d85 1281 }
49d41073
EZ		 1282 else
1283 {
1284 XTranslateCoordinates (FRAME_X_DISPLAY (f),
ca7bac79 1285
49d41073
EZ		 1286 /* From-window, to-window. */
1287 FRAME_X_DISPLAY_INFO (f)->root_window,
1288 FRAME_OUTER_WINDOW (f),
488dd4c4 1289
49d41073
EZ		 1290 /* From-position, to-position. */
1291 real_x, real_y, &outer_x, &outer_y,
488dd4c4 1292
49d41073
EZ		 1293 /* Child of win. */
1294 &child);
e9445337 1295 }
08a90d6a 1296
49d41073
EZ		 1297 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
1298 }
488dd4c4 1299
49d41073 1300 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
488dd4c4 1301
49d41073
EZ		 1302 UNBLOCK_INPUT;
1303
1304 if (had_errors) return;
488dd4c4 1305
49d41073
EZ		 1306 f->output_data.x->x_pixels_diff = -win_x;
1307 f->output_data.x->y_pixels_diff = -win_y;
1308 f->output_data.x->x_pixels_outer_diff = -outer_x;
1309 f->output_data.x->y_pixels_outer_diff = -outer_y;
1310
1311 *xptr = real_x;
1312 *yptr = real_y;
e9445337
RS		 1313}
1314
f676886a 1315/* Insert a description of internally-recorded parameters of frame X
01f1ba30
JB		 1316 into the parameter alist *ALISTPTR that is to be given to the user.
1317 Only parameters that are specific to the X window system
f676886a 1318 and whose values are not correctly recorded in the frame's
01f1ba30
JB		 1319 param_alist need to be considered here. */
1320
968b1234 1321void
f676886a
JB		 1322x_report_frame_params (f, alistptr)
1323 struct frame *f;
01f1ba30
JB		 1324 Lisp_Object *alistptr;
1325{
1326 char buf[16];
9b002b8d
KH		 1327 Lisp_Object tem;
1328
1329 /* Represent negative positions (off the top or left screen edge)
1330 in a way that Fmodify_frame_parameters will understand correctly. */
7556890b
RS		 1331 XSETINT (tem, f->output_data.x->left_pos);
1332 if (f->output_data.x->left_pos >= 0)
9b002b8d
KH		 1333 store_in_alist (alistptr, Qleft, tem);
1334 else
1335 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1336
7556890b
RS		 1337 XSETINT (tem, f->output_data.x->top_pos);
1338 if (f->output_data.x->top_pos >= 0)
9b002b8d
KH		 1339 store_in_alist (alistptr, Qtop, tem);
1340 else
1341 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
01f1ba30 1342
f9942c9e 1343 store_in_alist (alistptr, Qborder_width,
7556890b 1344 make_number (f->output_data.x->border_width));
f9942c9e 1345 store_in_alist (alistptr, Qinternal_border_width,
7556890b 1346 make_number (f->output_data.x->internal_border_width));
30bf44e0
KS		 1347 store_in_alist (alistptr, Qleft_fringe,
1348 make_number (f->output_data.x->left_fringe_width));
1349 store_in_alist (alistptr, Qright_fringe,
1350 make_number (f->output_data.x->right_fringe_width));
99f7c77f 1351 store_in_alist (alistptr, Qscroll_bar_width,
6155205e
RS		 1352 (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1353 ? make_number (0)
1354 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
1355 ? make_number (FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1356 /* nil means "use default width"
398101a6
RS		 1357 for non-toolkit scroll bar.
1358 ruler-mode.el depends on this. */
6155205e 1359 : Qnil));
7c118b57 1360 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
f9942c9e 1361 store_in_alist (alistptr, Qwindow_id,
01f1ba30 1362 build_string (buf));
333b20bb
GM		 1363#ifdef USE_X_TOOLKIT
1364 /* Tooltip frame may not have this widget. */
1365 if (f->output_data.x->widget)
1366#endif
1367 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
2cbebefb
RS		 1368 store_in_alist (alistptr, Qouter_window_id,
1369 build_string (buf));
f468da95 1370 store_in_alist (alistptr, Qicon_name, f->icon_name);
a8ccd803 1371 FRAME_SAMPLE_VISIBILITY (f);
d043f1a4
RS		 1372 store_in_alist (alistptr, Qvisibility,
1373 (FRAME_VISIBLE_P (f) ? Qt
1374 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
34ae77b5 1375 store_in_alist (alistptr, Qdisplay,
8e713be6 1376 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
e4f79258 1377
8c239ac3
RS		 1378 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1379 tem = Qnil;
1380 else
1381 XSETFASTINT (tem, f->output_data.x->parent_desc);
1382 store_in_alist (alistptr, Qparent_id, tem);
01f1ba30
JB		 1383}
1384\f
82978295 1385
d62c8769
GM		 1386
1387/* Gamma-correct COLOR on frame F. */
1388
1389void
1390gamma_correct (f, color)
1391 struct frame *f;
1392 XColor *color;
1393{
1394 if (f->gamma)
1395 {
1396 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1397 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1398 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1399 }
1400}
1401
1402
7b746c38
GM		 1403/* Decide if color named COLOR_NAME is valid for use on frame F. If
1404 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1405 allocate the color. Value is zero if COLOR_NAME is invalid, or
1406 no color could be allocated. */
e12d55b2 1407
01f1ba30 1408int
7b746c38
GM		 1409x_defined_color (f, color_name, color, alloc_p)
1410 struct frame *f;
1411 char *color_name;
1412 XColor *color;
1413 int alloc_p;
01f1ba30 1414{
7b746c38
GM		 1415 int success_p;
1416 Display *dpy = FRAME_X_DISPLAY (f);
1417 Colormap cmap = FRAME_X_COLORMAP (f);
01f1ba30
JB		 1418
1419 BLOCK_INPUT;
7b746c38
GM		 1420 success_p = XParseColor (dpy, cmap, color_name, color);
1421 if (success_p && alloc_p)
1422 success_p = x_alloc_nearest_color (f, cmap, color);
01f1ba30
JB		 1423 UNBLOCK_INPUT;
1424
7b746c38 1425 return success_p;
01f1ba30
JB		 1426}
1427
9b2956e2
GM		 1428
1429/* Return the pixel color value for color COLOR_NAME on frame F. If F
1430 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1431 Signal an error if color can't be allocated. */
01f1ba30
JB		 1432
1433int
9b2956e2 1434x_decode_color (f, color_name, mono_color)
b9dc4443 1435 FRAME_PTR f;
9b2956e2
GM		 1436 Lisp_Object color_name;
1437 int mono_color;
01f1ba30 1438{
b9dc4443 1439 XColor cdef;
01f1ba30 1440
b7826503 1441 CHECK_STRING (color_name);
01f1ba30 1442
9b2956e2
GM		 1443#if 0 /* Don't do this. It's wrong when we're not using the default
1444 colormap, it makes freeing difficult, and it's probably not
1445 an important optimization. */
d5db4077 1446 if (strcmp (SDATA (color_name), "black") == 0)
b9dc4443 1447 return BLACK_PIX_DEFAULT (f);
d5db4077 1448 else if (strcmp (SDATA (color_name), "white") == 0)
b9dc4443 1449 return WHITE_PIX_DEFAULT (f);
9b2956e2 1450#endif
01f1ba30 1451
9b2956e2 1452 /* Return MONO_COLOR for monochrome frames. */
b9dc4443 1453 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
9b2956e2 1454 return mono_color;
01f1ba30 1455
2d764c78 1456 /* x_defined_color is responsible for coping with failures
95626e11 1457 by looking for a near-miss. */
d5db4077 1458 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
95626e11
RS		 1459 return cdef.pixel;
1460
c301be26
GM		 1461 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1462 Fcons (color_name, Qnil)));
1463 return 0;
01f1ba30 1464}
9b2956e2
GM		 1465
1466
01f1ba30 1467\f
563b67aa
GM		 1468/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1469 the previous value of that parameter, NEW_VALUE is the new value. */
1470
1471static void
1472x_set_line_spacing (f, new_value, old_value)
1473 struct frame *f;
1474 Lisp_Object new_value, old_value;
1475{
1476 if (NILP (new_value))
1477 f->extra_line_spacing = 0;
1478 else if (NATNUMP (new_value))
1479 f->extra_line_spacing = XFASTINT (new_value);
1480 else
1a948b17 1481 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
563b67aa
GM		 1482 Fcons (new_value, Qnil)));
1483 if (FRAME_VISIBLE_P (f))
1484 redraw_frame (f);
1485}
1486
1487
ea0a1f53
GM		 1488/* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1489 the previous value of that parameter, NEW_VALUE is the new value.
1490 See also the comment of wait_for_wm in struct x_output. */
1491
1492static void
1493x_set_wait_for_wm (f, new_value, old_value)
1494 struct frame *f;
1495 Lisp_Object new_value, old_value;
1496{
1497 f->output_data.x->wait_for_wm = !NILP (new_value);
1498}
1499
1500
49d41073
EZ		 1501/* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
1502 the previous value of that parameter, NEW_VALUE is the new value. */
1503
1504static void
1505x_set_fullscreen (f, new_value, old_value)
1506 struct frame *f;
1507 Lisp_Object new_value, old_value;
1508{
1509 if (NILP (new_value))
1510 f->output_data.x->want_fullscreen = FULLSCREEN_NONE;
1511 else if (EQ (new_value, Qfullboth))
1512 f->output_data.x->want_fullscreen = FULLSCREEN_BOTH;
1513 else if (EQ (new_value, Qfullwidth))
1514 f->output_data.x->want_fullscreen = FULLSCREEN_WIDTH;
1515 else if (EQ (new_value, Qfullheight))
1516 f->output_data.x->want_fullscreen = FULLSCREEN_HEIGHT;
1517}
1518
1519
d62c8769 1520/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
ea0a1f53
GM		 1521 the previous value of that parameter, NEW_VALUE is the new
1522 value. */
d62c8769
GM		 1523
1524static void
1525x_set_screen_gamma (f, new_value, old_value)
1526 struct frame *f;
1527 Lisp_Object new_value, old_value;
1528{
1529 if (NILP (new_value))
1530 f->gamma = 0;
1531 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1532 /* The value 0.4545 is the normal viewing gamma. */
1533 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1534 else
1a948b17 1535 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
d62c8769
GM		 1536 Fcons (new_value, Qnil)));
1537
1538 clear_face_cache (0);
1539}
1540
1541
f676886a 1542/* Functions called only from `x_set_frame_param'
01f1ba30
JB		 1543 to set individual parameters.
1544
fe24a618 1545 If FRAME_X_WINDOW (f) is 0,
f676886a 1546 the frame is being created and its X-window does not exist yet.
01f1ba30
JB		 1547 In that case, just record the parameter's new value
1548 in the standard place; do not attempt to change the window. */
1549
1550void
f676886a
JB		 1551x_set_foreground_color (f, arg, oldval)
1552 struct frame *f;
01f1ba30
JB		 1553 Lisp_Object arg, oldval;
1554{
09393d07
GM		 1555 struct x_output *x = f->output_data.x;
1556 unsigned long fg, old_fg;
a76206dc 1557
09393d07
GM		 1558 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1559 old_fg = x->foreground_pixel;
1560 x->foreground_pixel = fg;
a76206dc 1561
fe24a618 1562 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1563 {
09393d07 1564 Display *dpy = FRAME_X_DISPLAY (f);
488dd4c4 1565
09393d07
GM		 1566 BLOCK_INPUT;
1567 XSetForeground (dpy, x->normal_gc, fg);
1568 XSetBackground (dpy, x->reverse_gc, fg);
36d42089 1569
09393d07
GM		 1570 if (x->cursor_pixel == old_fg)
1571 {
1572 unload_color (f, x->cursor_pixel);
1573 x->cursor_pixel = x_copy_color (f, fg);
1574 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1575 }
488dd4c4 1576
01f1ba30 1577 UNBLOCK_INPUT;
488dd4c4 1578
05c8abbe 1579 update_face_from_frame_parameter (f, Qforeground_color, arg);
488dd4c4 1580
179956b9 1581 if (FRAME_VISIBLE_P (f))
f676886a 1582 redraw_frame (f);
01f1ba30 1583 }
488dd4c4 1584
09393d07 1585 unload_color (f, old_fg);
01f1ba30
JB		 1586}
1587
1588void
f676886a
JB		 1589x_set_background_color (f, arg, oldval)
1590 struct frame *f;
01f1ba30
JB		 1591 Lisp_Object arg, oldval;
1592{
09393d07
GM		 1593 struct x_output *x = f->output_data.x;
1594 unsigned long bg;
01f1ba30 1595
09393d07
GM		 1596 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1597 unload_color (f, x->background_pixel);
1598 x->background_pixel = bg;
a76206dc 1599
fe24a618 1600 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1601 {
09393d07 1602 Display *dpy = FRAME_X_DISPLAY (f);
488dd4c4 1603
09393d07
GM		 1604 BLOCK_INPUT;
1605 XSetBackground (dpy, x->normal_gc, bg);
1606 XSetForeground (dpy, x->reverse_gc, bg);
1607 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1608 XSetForeground (dpy, x->cursor_gc, bg);
1609
488dd4c4
JD		 1610#ifdef USE_GTK
1611 xg_set_background_color (f, bg);
1612#endif
1613
f76e0368
GM		 1614#ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1615 toolkit scroll bars. */
1616 {
1617 Lisp_Object bar;
1618 for (bar = FRAME_SCROLL_BARS (f);
1619 !NILP (bar);
1620 bar = XSCROLL_BAR (bar)->next)
1621 {
1622 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1623 XSetWindowBackground (dpy, window, bg);
1624 }
1625 }
1626#endif /* USE_TOOLKIT_SCROLL_BARS */
01f1ba30 1627
09393d07 1628 UNBLOCK_INPUT;
05c8abbe 1629 update_face_from_frame_parameter (f, Qbackground_color, arg);
ea96210c 1630
179956b9 1631 if (FRAME_VISIBLE_P (f))
f676886a 1632 redraw_frame (f);
01f1ba30
JB		 1633 }
1634}
1635
1636void
f676886a
JB		 1637x_set_mouse_color (f, arg, oldval)
1638 struct frame *f;
01f1ba30
JB		 1639 Lisp_Object arg, oldval;
1640{
09393d07
GM		 1641 struct x_output *x = f->output_data.x;
1642 Display *dpy = FRAME_X_DISPLAY (f);
95f80c78 1643 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
0af913d7 1644 Cursor hourglass_cursor, horizontal_drag_cursor;
1dc6cfa6 1645 int count;
51a1d2d8 1646 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
09393d07 1647 unsigned long mask_color = x->background_pixel;
a76206dc 1648
51a1d2d8 1649 /* Don't let pointers be invisible. */
09393d07 1650 if (mask_color == pixel)
bcf26b38
GM		 1651 {
1652 x_free_colors (f, &pixel, 1);
09393d07 1653 pixel = x_copy_color (f, x->foreground_pixel);
bcf26b38 1654 }
a76206dc 1655
09393d07
GM		 1656 unload_color (f, x->mouse_pixel);
1657 x->mouse_pixel = pixel;
01f1ba30
JB		 1658
1659 BLOCK_INPUT;
fe24a618 1660
eb8c3be9 1661 /* It's not okay to crash if the user selects a screwy cursor. */
09393d07 1662 count = x_catch_errors (dpy);
fe24a618 1663
09393d07 1664 if (!NILP (Vx_pointer_shape))
01f1ba30 1665 {
b7826503 1666 CHECK_NUMBER (Vx_pointer_shape);
09393d07 1667 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
01f1ba30
JB		 1668 }
1669 else
09393d07
GM		 1670 cursor = XCreateFontCursor (dpy, XC_xterm);
1671 x_check_errors (dpy, "bad text pointer cursor: %s");
01f1ba30 1672
09393d07 1673 if (!NILP (Vx_nontext_pointer_shape))
01f1ba30 1674 {
b7826503 1675 CHECK_NUMBER (Vx_nontext_pointer_shape);
09393d07
GM		 1676 nontext_cursor
1677 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
01f1ba30
JB		 1678 }
1679 else
09393d07
GM		 1680 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1681 x_check_errors (dpy, "bad nontext pointer cursor: %s");
01f1ba30 1682
09393d07 1683 if (!NILP (Vx_hourglass_pointer_shape))
333b20bb 1684 {
b7826503 1685 CHECK_NUMBER (Vx_hourglass_pointer_shape);
09393d07
GM		 1686 hourglass_cursor
1687 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
333b20bb
GM		 1688 }
1689 else
09393d07
GM		 1690 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1691 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
488dd4c4 1692
09393d07
GM		 1693 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1694 if (!NILP (Vx_mode_pointer_shape))
01f1ba30 1695 {
b7826503 1696 CHECK_NUMBER (Vx_mode_pointer_shape);
09393d07 1697 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
01f1ba30
JB		 1698 }
1699 else
09393d07
GM		 1700 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1701 x_check_errors (dpy, "bad modeline pointer cursor: %s");
95f80c78 1702
09393d07 1703 if (!NILP (Vx_sensitive_text_pointer_shape))
95f80c78 1704 {
b7826503 1705 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
ca0ecbf5 1706 cross_cursor
09393d07 1707 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
95f80c78
FP		 1708 }
1709 else
5d449b17 1710 cross_cursor = XCreateFontCursor (dpy, XC_hand2);
01f1ba30 1711
8fb4ec9c
GM		 1712 if (!NILP (Vx_window_horizontal_drag_shape))
1713 {
b7826503 1714 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
8fb4ec9c 1715 horizontal_drag_cursor
09393d07 1716 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
8fb4ec9c
GM		 1717 }
1718 else
1719 horizontal_drag_cursor
09393d07 1720 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
8fb4ec9c 1721
fe24a618 1722 /* Check and report errors with the above calls. */
09393d07
GM		 1723 x_check_errors (dpy, "can't set cursor shape: %s");
1724 x_uncatch_errors (dpy, count);
fe24a618 1725
01f1ba30
JB		 1726 {
1727 XColor fore_color, back_color;
1728
09393d07 1729 fore_color.pixel = x->mouse_pixel;
a31fedb7 1730 x_query_color (f, &fore_color);
01f1ba30 1731 back_color.pixel = mask_color;
a31fedb7 1732 x_query_color (f, &back_color);
488dd4c4 1733
09393d07
GM		 1734 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1735 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1736 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1737 XRecolorCursor (dpy, cross_cursor, &fore_color, &back_color);
1738 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1739 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
01f1ba30 1740 }
01f1ba30 1741
fe24a618 1742 if (FRAME_X_WINDOW (f) != 0)
09393d07
GM		 1743 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1744
1745 if (cursor != x->text_cursor
1746 && x->text_cursor != 0)
1747 XFreeCursor (dpy, x->text_cursor);
1748 x->text_cursor = cursor;
1749
1750 if (nontext_cursor != x->nontext_cursor
1751 && x->nontext_cursor != 0)
1752 XFreeCursor (dpy, x->nontext_cursor);
1753 x->nontext_cursor = nontext_cursor;
1754
1755 if (hourglass_cursor != x->hourglass_cursor
1756 && x->hourglass_cursor != 0)
1757 XFreeCursor (dpy, x->hourglass_cursor);
1758 x->hourglass_cursor = hourglass_cursor;
1759
1760 if (mode_cursor != x->modeline_cursor
1761 && x->modeline_cursor != 0)
1762 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1763 x->modeline_cursor = mode_cursor;
488dd4c4 1764
09393d07
GM		 1765 if (cross_cursor != x->cross_cursor
1766 && x->cross_cursor != 0)
1767 XFreeCursor (dpy, x->cross_cursor);
1768 x->cross_cursor = cross_cursor;
01f1ba30 1769
09393d07
GM		 1770 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1771 && x->horizontal_drag_cursor != 0)
1772 XFreeCursor (dpy, x->horizontal_drag_cursor);
1773 x->horizontal_drag_cursor = horizontal_drag_cursor;
8fb4ec9c 1774
09393d07 1775 XFlush (dpy);
01f1ba30 1776 UNBLOCK_INPUT;
05c8abbe
GM		 1777
1778 update_face_from_frame_parameter (f, Qmouse_color, arg);
01f1ba30
JB		 1779}
1780
1781void
f676886a
JB		 1782x_set_cursor_color (f, arg, oldval)
1783 struct frame *f;
01f1ba30
JB		 1784 Lisp_Object arg, oldval;
1785{
a76206dc 1786 unsigned long fore_pixel, pixel;
10168ebb 1787 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
09393d07 1788 struct x_output *x = f->output_data.x;
01f1ba30 1789
10168ebb
GM		 1790 if (!NILP (Vx_cursor_fore_pixel))
1791 {
1792 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1793 WHITE_PIX_DEFAULT (f));
1794 fore_pixel_allocated_p = 1;
1795 }
01f1ba30 1796 else
09393d07 1797 fore_pixel = x->background_pixel;
488dd4c4 1798
a76206dc 1799 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
10168ebb 1800 pixel_allocated_p = 1;
a76206dc 1801
f9942c9e 1802 /* Make sure that the cursor color differs from the background color. */
09393d07 1803 if (pixel == x->background_pixel)
01f1ba30 1804 {
10168ebb
GM		 1805 if (pixel_allocated_p)
1806 {
1807 x_free_colors (f, &pixel, 1);
1808 pixel_allocated_p = 0;
1809 }
488dd4c4 1810
09393d07 1811 pixel = x->mouse_pixel;
a76206dc 1812 if (pixel == fore_pixel)
10168ebb
GM		 1813 {
1814 if (fore_pixel_allocated_p)
1815 {
1816 x_free_colors (f, &fore_pixel, 1);
1817 fore_pixel_allocated_p = 0;
1818 }
09393d07 1819 fore_pixel = x->background_pixel;
10168ebb 1820 }
01f1ba30 1821 }
a76206dc 1822
09393d07 1823 unload_color (f, x->cursor_foreground_pixel);
10168ebb
GM		 1824 if (!fore_pixel_allocated_p)
1825 fore_pixel = x_copy_color (f, fore_pixel);
09393d07 1826 x->cursor_foreground_pixel = fore_pixel;
01f1ba30 1827
09393d07 1828 unload_color (f, x->cursor_pixel);
10168ebb
GM		 1829 if (!pixel_allocated_p)
1830 pixel = x_copy_color (f, pixel);
09393d07 1831 x->cursor_pixel = pixel;
a76206dc 1832
fe24a618 1833 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1834 {
01f1ba30 1835 BLOCK_INPUT;
09393d07
GM		 1836 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1837 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
01f1ba30 1838 UNBLOCK_INPUT;
01f1ba30 1839
179956b9 1840 if (FRAME_VISIBLE_P (f))
01f1ba30 1841 {
cedadcfa
RS		 1842 x_update_cursor (f, 0);
1843 x_update_cursor (f, 1);
01f1ba30
JB		 1844 }
1845 }
05c8abbe
GM		 1846
1847 update_face_from_frame_parameter (f, Qcursor_color, arg);
01f1ba30 1848}
943b580d 1849\f
f676886a 1850/* Set the border-color of frame F to value described by ARG.
01f1ba30
JB		 1851 ARG can be a string naming a color.
1852 The border-color is used for the border that is drawn by the X server.
1853 Note that this does not fully take effect if done before
f676886a 1854 F has an x-window; it must be redone when the window is created.
01f1ba30
JB		 1855
1856 Note: this is done in two routines because of the way X10 works.
1857
1858 Note: under X11, this is normally the province of the window manager,
b9dc4443 1859 and so emacs' border colors may be overridden. */
01f1ba30
JB		 1860
1861void
f676886a
JB		 1862x_set_border_color (f, arg, oldval)
1863 struct frame *f;
01f1ba30
JB		 1864 Lisp_Object arg, oldval;
1865{
01f1ba30
JB		 1866 int pix;
1867
b7826503 1868 CHECK_STRING (arg);
b9dc4443 1869 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
f676886a 1870 x_set_border_pixel (f, pix);
05c8abbe 1871 update_face_from_frame_parameter (f, Qborder_color, arg);
01f1ba30
JB		 1872}
1873
f676886a 1874/* Set the border-color of frame F to pixel value PIX.
01f1ba30 1875 Note that this does not fully take effect if done before
f676886a 1876 F has an x-window. */
01f1ba30 1877
968b1234 1878void
f676886a
JB		 1879x_set_border_pixel (f, pix)
1880 struct frame *f;
01f1ba30
JB		 1881 int pix;
1882{
a76206dc 1883 unload_color (f, f->output_data.x->border_pixel);
7556890b 1884 f->output_data.x->border_pixel = pix;
01f1ba30 1885
7556890b 1886 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
01f1ba30 1887 {
01f1ba30 1888 BLOCK_INPUT;
b9dc4443 1889 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
270958e8 1890 (unsigned long)pix);
01f1ba30
JB		 1891 UNBLOCK_INPUT;
1892
179956b9 1893 if (FRAME_VISIBLE_P (f))
f676886a 1894 redraw_frame (f);
01f1ba30
JB		 1895 }
1896}
1897
0d1469d6 1898
0d1469d6
GM		 1899
1900void
1901x_set_cursor_type (f, arg, oldval)
1902 FRAME_PTR f;
1903 Lisp_Object arg, oldval;
1904{
33b2311e 1905 set_frame_cursor_types (f, arg);
dbc4e1c1 1906
75691005
RS		 1907 /* Make sure the cursor gets redrawn. */
1908 cursor_type_changed = 1;
dbc4e1c1 1909}
943b580d 1910\f
01f1ba30 1911void
f676886a
JB		 1912x_set_icon_type (f, arg, oldval)
1913 struct frame *f;
01f1ba30
JB		 1914 Lisp_Object arg, oldval;
1915{
01f1ba30
JB		 1916 int result;
1917
203c1d73
RS		 1918 if (STRINGP (arg))
1919 {
1920 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1921 return;
1922 }
1923 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
01f1ba30
JB		 1924 return;
1925
1926 BLOCK_INPUT;
265a9e55 1927 if (NILP (arg))
80534dd6 1928 result = x_text_icon (f,
d5db4077 1929 (char *) SDATA ((!NILP (f->icon_name)
f468da95 1930 ? f->icon_name
d5db4077 1931 : f->name)));
f1c7b5a6
RS		 1932 else
1933 result = x_bitmap_icon (f, arg);
01f1ba30
JB		 1934
1935 if (result)
1936 {
01f1ba30 1937 UNBLOCK_INPUT;
0fb53770 1938 error ("No icon window available");
01f1ba30
JB		 1939 }
1940
b9dc4443 1941 XFlush (FRAME_X_DISPLAY (f));
01f1ba30
JB		 1942 UNBLOCK_INPUT;
1943}
1944
f1c7b5a6 1945/* Return non-nil if frame F wants a bitmap icon. */
0fb53770 1946
f1c7b5a6 1947Lisp_Object
0fb53770
RS		 1948x_icon_type (f)
1949 FRAME_PTR f;
1950{
1951 Lisp_Object tem;
1952
1953 tem = assq_no_quit (Qicon_type, f->param_alist);
f1c7b5a6 1954 if (CONSP (tem))
8e713be6 1955 return XCDR (tem);
f1c7b5a6
RS		 1956 else
1957 return Qnil;
0fb53770
RS		 1958}
1959
80534dd6
KH		 1960void
1961x_set_icon_name (f, arg, oldval)
1962 struct frame *f;
1963 Lisp_Object arg, oldval;
1964{
80534dd6
KH		 1965 int result;
1966
1967 if (STRINGP (arg))
1968 {
1969 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1970 return;
1971 }
1972 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1973 return;
1974
f468da95 1975 f->icon_name = arg;
80534dd6 1976
7556890b 1977 if (f->output_data.x->icon_bitmap != 0)
80534dd6
KH		 1978 return;
1979
1980 BLOCK_INPUT;
1981
1982 result = x_text_icon (f,
d5db4077
KR		 1983 (char *) SDATA ((!NILP (f->icon_name)
1984 ? f->icon_name
1985 : !NILP (f->title)
1986 ? f->title
1987 : f->name)));
80534dd6
KH		 1988
1989 if (result)
1990 {
1991 UNBLOCK_INPUT;
1992 error ("No icon window available");
1993 }
1994
80534dd6
KH		 1995 XFlush (FRAME_X_DISPLAY (f));
1996 UNBLOCK_INPUT;
1997}
943b580d 1998\f
01f1ba30 1999void
f676886a
JB		 2000x_set_font (f, arg, oldval)
2001 struct frame *f;
01f1ba30
JB		 2002 Lisp_Object arg, oldval;
2003{
ea96210c 2004 Lisp_Object result;
942ea06d 2005 Lisp_Object fontset_name;
a367641f 2006 Lisp_Object frame;
57c5889c 2007 int old_fontset = f->output_data.x->fontset;
01f1ba30 2008
b7826503 2009 CHECK_STRING (arg);
01f1ba30 2010
49965a29 2011 fontset_name = Fquery_fontset (arg, Qnil);
942ea06d 2012
01f1ba30 2013 BLOCK_INPUT;
942ea06d 2014 result = (STRINGP (fontset_name)
d5db4077
KR		 2015 ? x_new_fontset (f, SDATA (fontset_name))
2016 : x_new_font (f, SDATA (arg)));
01f1ba30 2017 UNBLOCK_INPUT;
488dd4c4 2018
ea96210c 2019 if (EQ (result, Qnil))
d5db4077 2020 error ("Font `%s' is not defined", SDATA (arg));
ea96210c 2021 else if (EQ (result, Qt))
26e18ed9 2022 error ("The characters of the given font have varying widths");
ea96210c
JB		 2023 else if (STRINGP (result))
2024 {
57c5889c
GM		 2025 if (STRINGP (fontset_name))
2026 {
2027 /* Fontset names are built from ASCII font names, so the
2028 names may be equal despite there was a change. */
2029 if (old_fontset == f->output_data.x->fontset)
2030 return;
2031 }
2032 else if (!NILP (Fequal (result, oldval)))
1d090605 2033 return;
488dd4c4 2034
ea96210c 2035 store_frame_param (f, Qfont, result);
333b20bb 2036 recompute_basic_faces (f);
ea96210c
JB		 2037 }
2038 else
2039 abort ();
a367641f 2040
8938a4fb 2041 do_pending_window_change (0);
95aa0336 2042
333b20bb
GM		 2043 /* Don't call `face-set-after-frame-default' when faces haven't been
2044 initialized yet. This is the case when called from
2045 Fx_create_frame. In that case, the X widget or window doesn't
2046 exist either, and we can end up in x_report_frame_params with a
2047 null widget which gives a segfault. */
2048 if (FRAME_FACE_CACHE (f))
2049 {
2050 XSETFRAME (frame, f);
2051 call1 (Qface_set_after_frame_default, frame);
2052 }
01f1ba30
JB		 2053}
2054
b3ba0aa8
KS		 2055static void
2056x_set_fringe_width (f, new_value, old_value)
2057 struct frame *f;
2058 Lisp_Object new_value, old_value;
2059{
2060 x_compute_fringe_widths (f, 1);
2061}
2062
01f1ba30 2063void
f676886a
JB		 2064x_set_border_width (f, arg, oldval)
2065 struct frame *f;
01f1ba30
JB		 2066 Lisp_Object arg, oldval;
2067{
b7826503 2068 CHECK_NUMBER (arg);
01f1ba30 2069
7556890b 2070 if (XINT (arg) == f->output_data.x->border_width)
01f1ba30
JB		 2071 return;
2072
fe24a618 2073 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB		 2074 error ("Cannot change the border width of a window");
2075
7556890b 2076 f->output_data.x->border_width = XINT (arg);
01f1ba30
JB		 2077}
2078
2079void
f676886a
JB		 2080x_set_internal_border_width (f, arg, oldval)
2081 struct frame *f;
01f1ba30
JB		 2082 Lisp_Object arg, oldval;
2083{
7556890b 2084 int old = f->output_data.x->internal_border_width;
01f1ba30 2085
b7826503 2086 CHECK_NUMBER (arg);
7556890b
RS		 2087 f->output_data.x->internal_border_width = XINT (arg);
2088 if (f->output_data.x->internal_border_width < 0)
2089 f->output_data.x->internal_border_width = 0;
01f1ba30 2090
d3b06468 2091#ifdef USE_X_TOOLKIT
2a8a07d4 2092 if (f->output_data.x->edit_widget)
968b1234 2093 widget_store_internal_border (f->output_data.x->edit_widget);
d3b06468 2094#endif
2a8a07d4 2095
7556890b 2096 if (f->output_data.x->internal_border_width == old)
01f1ba30
JB		 2097 return;
2098
fe24a618 2099 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 2100 {
363f7e15 2101 x_set_window_size (f, 0, f->width, f->height);
f676886a 2102 SET_FRAME_GARBAGED (f);
8938a4fb 2103 do_pending_window_change (0);
01f1ba30 2104 }
ea42193a
GM		 2105 else
2106 SET_FRAME_GARBAGED (f);
01f1ba30
JB		 2107}
2108
d043f1a4
RS		 2109void
2110x_set_visibility (f, value, oldval)
2111 struct frame *f;
2112 Lisp_Object value, oldval;
2113{
2114 Lisp_Object frame;
191ed777 2115 XSETFRAME (frame, f);
d043f1a4
RS		 2116
2117 if (NILP (value))
363f7e15 2118 Fmake_frame_invisible (frame, Qt);
49795535 2119 else if (EQ (value, Qicon))
d043f1a4 2120 Ficonify_frame (frame);
49795535
JB		 2121 else
2122 Fmake_frame_visible (frame);
d043f1a4 2123}
52de7ce9 2124
943b580d 2125\f
52de7ce9
GM		 2126/* Change window heights in windows rooted in WINDOW by N lines. */
2127
d043f1a4 2128static void
52de7ce9 2129x_change_window_heights (window, n)
d043f1a4
RS		 2130 Lisp_Object window;
2131 int n;
2132{
47c0f58b 2133 struct window *w = XWINDOW (window);
d043f1a4 2134
e33f7330
KH		 2135 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2136 XSETFASTINT (w->height, XFASTINT (w->height) - n);
d043f1a4 2137
4336c705
GM		 2138 if (INTEGERP (w->orig_top))
2139 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2140 if (INTEGERP (w->orig_height))
2141 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2142
47c0f58b
RS		 2143 /* Handle just the top child in a vertical split. */
2144 if (!NILP (w->vchild))
52de7ce9 2145 x_change_window_heights (w->vchild, n);
d043f1a4 2146
47c0f58b
RS		 2147 /* Adjust all children in a horizontal split. */
2148 for (window = w->hchild; !NILP (window); window = w->next)
2149 {
2150 w = XWINDOW (window);
52de7ce9 2151 x_change_window_heights (window, n);
d043f1a4
RS		 2152 }
2153}
2154
2155void
2156x_set_menu_bar_lines (f, value, oldval)
2157 struct frame *f;
2158 Lisp_Object value, oldval;
2159{
2160 int nlines;
b6d7acec 2161#ifndef USE_X_TOOLKIT
d043f1a4 2162 int olines = FRAME_MENU_BAR_LINES (f);
b6d7acec 2163#endif
d043f1a4 2164
f64ba6ea
JB		 2165 /* Right now, menu bars don't work properly in minibuf-only frames;
2166 most of the commands try to apply themselves to the minibuffer
333b20bb 2167 frame itself, and get an error because you can't switch buffers
f64ba6ea 2168 in or split the minibuffer window. */
519066d2 2169 if (FRAME_MINIBUF_ONLY_P (f))
f64ba6ea
JB		 2170 return;
2171
6a5e54e2 2172 if (INTEGERP (value))
d043f1a4
RS		 2173 nlines = XINT (value);
2174 else
2175 nlines = 0;
2176
3d09b6be
RS		 2177 /* Make sure we redisplay all windows in this frame. */
2178 windows_or_buffers_changed++;
2179
488dd4c4 2180#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
9ef48a9d
RS		 2181 FRAME_MENU_BAR_LINES (f) = 0;
2182 if (nlines)
0d8ef3f4
RS		 2183 {
2184 FRAME_EXTERNAL_MENU_BAR (f) = 1;
97a1ff91 2185 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
0d8ef3f4
RS		 2186 /* Make sure next redisplay shows the menu bar. */
2187 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
2188 }
9ef48a9d
RS		 2189 else
2190 {
6bc20398
FP		 2191 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2192 free_frame_menubar (f);
9ef48a9d 2193 FRAME_EXTERNAL_MENU_BAR (f) = 0;
97a1ff91
RS		 2194 if (FRAME_X_P (f))
2195 f->output_data.x->menubar_widget = 0;
9ef48a9d 2196 }
488dd4c4 2197#else /* not USE_X_TOOLKIT && not USE_GTK */
d043f1a4 2198 FRAME_MENU_BAR_LINES (f) = nlines;
52de7ce9 2199 x_change_window_heights (f->root_window, nlines - olines);
9ef48a9d 2200#endif /* not USE_X_TOOLKIT */
333b20bb
GM		 2201 adjust_glyphs (f);
2202}
2203
2204
2205/* Set the number of lines used for the tool bar of frame F to VALUE.
2206 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2207 is the old number of tool bar lines. This function changes the
2208 height of all windows on frame F to match the new tool bar height.
2209 The frame's height doesn't change. */
2210
2211void
9ea173e8 2212x_set_tool_bar_lines (f, value, oldval)
333b20bb
GM		 2213 struct frame *f;
2214 Lisp_Object value, oldval;
2215{
52de7ce9
GM		 2216 int delta, nlines, root_height;
2217 Lisp_Object root_window;
333b20bb 2218
e870b7ba
GM		 2219 /* Treat tool bars like menu bars. */
2220 if (FRAME_MINIBUF_ONLY_P (f))
2221 return;
2222
333b20bb
GM		 2223 /* Use VALUE only if an integer >= 0. */
2224 if (INTEGERP (value) && XINT (value) >= 0)
2225 nlines = XFASTINT (value);
2226 else
2227 nlines = 0;
2228
488dd4c4
JD		 2229#ifdef USE_GTK
2230 FRAME_TOOL_BAR_LINES (f) = 0;
2231 if (nlines)
2232 {
2233 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
2234 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
2235 /* Make sure next redisplay shows the tool bar. */
2236 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
2237 update_frame_tool_bar (f);
2238 }
2239 else
2240 {
2241 if (FRAME_EXTERNAL_TOOL_BAR (f))
2242 free_frame_tool_bar (f);
2243 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
2244 }
2245
2246 return;
2247#endif
2248
2249 /* Make sure we redisplay all windows in this frame. */
333b20bb
GM		 2250 ++windows_or_buffers_changed;
2251
9ea173e8 2252 delta = nlines - FRAME_TOOL_BAR_LINES (f);
52de7ce9
GM		 2253
2254 /* Don't resize the tool-bar to more than we have room for. */
2255 root_window = FRAME_ROOT_WINDOW (f);
2256 root_height = XINT (XWINDOW (root_window)->height);
2257 if (root_height - delta < 1)
2258 {
2259 delta = root_height - 1;
2260 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2261 }
2262
9ea173e8 2263 FRAME_TOOL_BAR_LINES (f) = nlines;
52de7ce9 2264 x_change_window_heights (root_window, delta);
333b20bb 2265 adjust_glyphs (f);
488dd4c4 2266
ccba751c
GM		 2267 /* We also have to make sure that the internal border at the top of
2268 the frame, below the menu bar or tool bar, is redrawn when the
2269 tool bar disappears. This is so because the internal border is
2270 below the tool bar if one is displayed, but is below the menu bar
2271 if there isn't a tool bar. The tool bar draws into the area
2272 below the menu bar. */
2273 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2274 {
2275 updating_frame = f;
2276 clear_frame ();
fb3cd89b 2277 clear_current_matrices (f);
ccba751c
GM		 2278 updating_frame = NULL;
2279 }
b6f91066
GM		 2280
2281 /* If the tool bar gets smaller, the internal border below it
2282 has to be cleared. It was formerly part of the display
2283 of the larger tool bar, and updating windows won't clear it. */
2284 if (delta < 0)
2285 {
2286 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2287 int width = PIXEL_WIDTH (f);
2288 int y = nlines * CANON_Y_UNIT (f);
2289
2290 BLOCK_INPUT;
161d30fd
GM		 2291 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2292 0, y, width, height, False);
b6f91066 2293 UNBLOCK_INPUT;
ddc24747
GM		 2294
2295 if (WINDOWP (f->tool_bar_window))
2296 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
b6f91066 2297 }
333b20bb
GM		 2298}
2299
2300
2301/* Set the foreground color for scroll bars on frame F to VALUE.
2302 VALUE should be a string, a color name. If it isn't a string or
2303 isn't a valid color name, do nothing. OLDVAL is the old value of
2304 the frame parameter. */
2305
2306void
2307x_set_scroll_bar_foreground (f, value, oldval)
2308 struct frame *f;
2309 Lisp_Object value, oldval;
2310{
2311 unsigned long pixel;
488dd4c4 2312
333b20bb
GM		 2313 if (STRINGP (value))
2314 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
2315 else
2316 pixel = -1;
2317
2318 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
2319 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
488dd4c4 2320
333b20bb
GM		 2321 f->output_data.x->scroll_bar_foreground_pixel = pixel;
2322 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2323 {
2324 /* Remove all scroll bars because they have wrong colors. */
2325 if (condemn_scroll_bars_hook)
2326 (*condemn_scroll_bars_hook) (f);
2327 if (judge_scroll_bars_hook)
2328 (*judge_scroll_bars_hook) (f);
05c8abbe
GM		 2329
2330 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
333b20bb
GM		 2331 redraw_frame (f);
2332 }
2333}
2334
2335
2336/* Set the background color for scroll bars on frame F to VALUE VALUE
2337 should be a string, a color name. If it isn't a string or isn't a
2338 valid color name, do nothing. OLDVAL is the old value of the frame
2339 parameter. */
2340
2341void
2342x_set_scroll_bar_background (f, value, oldval)
2343 struct frame *f;
2344 Lisp_Object value, oldval;
2345{
2346 unsigned long pixel;
2347
2348 if (STRINGP (value))
2349 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
2350 else
2351 pixel = -1;
488dd4c4 2352
333b20bb
GM		 2353 if (f->output_data.x->scroll_bar_background_pixel != -1)
2354 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
488dd4c4 2355
f15340b7
MB		 2356#ifdef USE_TOOLKIT_SCROLL_BARS
2357 /* Scrollbar shadow colors. */
2358 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
2359 {
2360 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
2361 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
2362 }
2363 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
2364 {
2365 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
2366 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
2367 }
2368#endif /* USE_TOOLKIT_SCROLL_BARS */
2369
333b20bb
GM		 2370 f->output_data.x->scroll_bar_background_pixel = pixel;
2371 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2372 {
2373 /* Remove all scroll bars because they have wrong colors. */
2374 if (condemn_scroll_bars_hook)
2375 (*condemn_scroll_bars_hook) (f);
2376 if (judge_scroll_bars_hook)
2377 (*judge_scroll_bars_hook) (f);
488dd4c4 2378
05c8abbe 2379 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
333b20bb
GM		 2380 redraw_frame (f);
2381 }
d043f1a4 2382}
333b20bb 2383
943b580d 2384\f
3a258507 2385/* Encode Lisp string STRING as a text in a format appropriate for
96db09e4
KH		 2386 XICCC (X Inter Client Communication Conventions).
2387
2388 If STRING contains only ASCII characters, do no conversion and
2389 return the string data of STRING. Otherwise, encode the text by
2390 CODING_SYSTEM, and return a newly allocated memory area which
2391 should be freed by `xfree' by a caller.
2392
37323f34
EZ		 2393 SELECTIONP non-zero means the string is being encoded for an X
2394 selection, so it is safe to run pre-write conversions (which
2395 may run Lisp code).
2396
96db09e4
KH		 2397 Store the byte length of resulting text in *TEXT_BYTES.
2398
d60660d6 2399 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
96db09e4 2400 which means that the `encoding' of the result can be `STRING'.
d60660d6 2401 Otherwise store 0 in *STRINGP, which means that the `encoding' of
96db09e4
KH		 2402 the result should be `COMPOUND_TEXT'. */
2403
2404unsigned char *
37323f34 2405x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
96db09e4 2406 Lisp_Object string, coding_system;
d60660d6 2407 int *text_bytes, *stringp;
37323f34 2408 int selectionp;
96db09e4 2409{
d5db4077
KR		 2410 unsigned char *str = SDATA (string);
2411 int chars = SCHARS (string);
2412 int bytes = SBYTES (string);
96db09e4
KH		 2413 int charset_info;
2414 int bufsize;
2415 unsigned char *buf;
2416 struct coding_system coding;
43dc73f1 2417 extern Lisp_Object Qcompound_text_with_extensions;
96db09e4
KH		 2418
2419 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
2420 if (charset_info == 0)
2421 {
2422 /* No multibyte character in OBJ. We need not encode it. */
2423 *text_bytes = bytes;
d60660d6 2424 *stringp = 1;
96db09e4
KH		 2425 return str;
2426 }
2427
2428 setup_coding_system (coding_system, &coding);
37323f34
EZ		 2429 if (selectionp
2430 && SYMBOLP (coding.pre_write_conversion)
2431 && !NILP (Ffboundp (coding.pre_write_conversion)))
2432 {
2433 string = run_pre_post_conversion_on_str (string, &coding, 1);
d5db4077
KR		 2434 str = SDATA (string);
2435 chars = SCHARS (string);
2436 bytes = SBYTES (string);
37323f34 2437 }
96db09e4
KH		 2438 coding.src_multibyte = 1;
2439 coding.dst_multibyte = 0;
2440 coding.mode |= CODING_MODE_LAST_BLOCK;
d60660d6
KH		 2441 if (coding.type == coding_type_iso2022)
2442 coding.flags |= CODING_FLAG_ISO_SAFE;
35bc5887
KH		 2443 /* We suppress producing escape sequences for composition. */
2444 coding.composing = COMPOSITION_DISABLED;
96db09e4
KH		 2445 bufsize = encoding_buffer_size (&coding, bytes);
2446 buf = (unsigned char *) xmalloc (bufsize);
2447 encode_coding (&coding, str, buf, bytes, bufsize);
2448 *text_bytes = coding.produced;
43dc73f1
EZ		 2449 *stringp = (charset_info == 1
2450 || (!EQ (coding_system, Qcompound_text)
2451 && !EQ (coding_system, Qcompound_text_with_extensions)));
96db09e4
KH		 2452 return buf;
2453}
2454
2455\f
75f9d625 2456/* Change the name of frame F to NAME. If NAME is nil, set F's name to
f945b920
JB		 2457 x_id_name.
2458
2459 If EXPLICIT is non-zero, that indicates that lisp code is setting the
75f9d625
DM		 2460 name; if NAME is a string, set F's name to NAME and set
2461 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
f945b920
JB		 2462
2463 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2464 suggesting a new name, which lisp code should override; if
2465 F->explicit_name is set, ignore the new name; otherwise, set it. */
2466
2467void
2468x_set_name (f, name, explicit)
2469 struct frame *f;
2470 Lisp_Object name;
2471 int explicit;
2472{
488dd4c4 2473 /* Make sure that requests from lisp code override requests from
f945b920
JB		 2474 Emacs redisplay code. */
2475 if (explicit)
2476 {
2477 /* If we're switching from explicit to implicit, we had better
2478 update the mode lines and thereby update the title. */
2479 if (f->explicit_name && NILP (name))
cf177271 2480 update_mode_lines = 1;
f945b920
JB		 2481
2482 f->explicit_name = ! NILP (name);
2483 }
2484 else if (f->explicit_name)
2485 return;
2486
2487 /* If NAME is nil, set the name to the x_id_name. */
2488 if (NILP (name))
f10f0b79
RS		 2489 {
2490 /* Check for no change needed in this very common case
2491 before we do any consing. */
08a90d6a 2492 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
d5db4077 2493 SDATA (f->name)))
f10f0b79 2494 return;
08a90d6a 2495 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
f10f0b79 2496 }
62265f1c 2497 else
b7826503 2498 CHECK_STRING (name);
01f1ba30 2499
f945b920
JB		 2500 /* Don't change the name if it's already NAME. */
2501 if (! NILP (Fstring_equal (name, f->name)))
daa37602
JB		 2502 return;
2503
943b580d
RS		 2504 f->name = name;
2505
2506 /* For setting the frame title, the title parameter should override
2507 the name parameter. */
2508 if (! NILP (f->title))
2509 name = f->title;
2510
fe24a618 2511 if (FRAME_X_WINDOW (f))
01f1ba30 2512 {
01f1ba30 2513 BLOCK_INPUT;
fe24a618
JB		 2514#ifdef HAVE_X11R4
2515 {
80534dd6 2516 XTextProperty text, icon;
d60660d6 2517 int bytes, stringp;
11270583 2518 Lisp_Object coding_system;
80534dd6 2519
3201ea57
KH		 2520 /* Note: Encoding strategy
2521
2522 We encode NAME by compound-text and use "COMPOUND-TEXT" in
2523 text.encoding. But, there are non-internationalized window
2524 managers which don't support that encoding. So, if NAME
2525 contains only ASCII and 8859-1 characters, encode it by
2526 iso-latin-1, and use "STRING" in text.encoding hoping that
2527 such window manager at least analize this format correctly,
2528 i.e. treat 8-bit bytes as 8859-1 characters.
2529
2530 We may also be able to use "UTF8_STRING" in text.encoding
2531 in the feature which can encode all Unicode characters.
2532 But, for the moment, there's no way to know that the
2533 current window manager supports it or not. */
869331ee 2534 coding_system = Qcompound_text;
37323f34 2535 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
d60660d6 2536 text.encoding = (stringp ? XA_STRING
96db09e4 2537 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
fe24a618 2538 text.format = 8;
96db09e4 2539 text.nitems = bytes;
80534dd6 2540
96db09e4
KH		 2541 if (NILP (f->icon_name))
2542 {
2543 icon = text;
2544 }
2545 else
2546 {
3201ea57 2547 /* See the above comment "Note: Encoding strategy". */
37323f34 2548 icon.value = x_encode_text (f->icon_name, coding_system, 0,
d60660d6
KH		 2549 &bytes, &stringp);
2550 icon.encoding = (stringp ? XA_STRING
96db09e4
KH		 2551 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2552 icon.format = 8;
2553 icon.nitems = bytes;
2554 }
9ef48a9d 2555#ifdef USE_X_TOOLKIT
b9dc4443 2556 XSetWMName (FRAME_X_DISPLAY (f),
7556890b
RS		 2557 XtWindow (f->output_data.x->widget), &text);
2558 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
80534dd6 2559 &icon);
9ef48a9d 2560#else /* not USE_X_TOOLKIT */
488dd4c4
JD		 2561#ifdef USE_GTK
2562 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2563 SDATA (name));
2564 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2565 &icon);
2566#else /* not USE_GTK */
b9dc4443 2567 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
80534dd6 2568 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
488dd4c4 2569#endif /* not USE_GTK */
9ef48a9d 2570#endif /* not USE_X_TOOLKIT */
96db09e4 2571 if (!NILP (f->icon_name)
1b49bf99 2572 && icon.value != (unsigned char *) SDATA (f->icon_name))
96db09e4 2573 xfree (icon.value);
1b49bf99 2574 if (text.value != (unsigned char *) SDATA (name))
96db09e4 2575 xfree (text.value);
fe24a618 2576 }
9ef48a9d 2577#else /* not HAVE_X11R4 */
b9dc4443 2578 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
d5db4077 2579 SDATA (name));
b9dc4443 2580 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
d5db4077 2581 SDATA (name));
9ef48a9d 2582#endif /* not HAVE_X11R4 */
01f1ba30
JB		 2583 UNBLOCK_INPUT;
2584 }
f945b920
JB		 2585}
2586
2587/* This function should be called when the user's lisp code has
2588 specified a name for the frame; the name will override any set by the
2589 redisplay code. */
2590void
2591x_explicitly_set_name (f, arg, oldval)
2592 FRAME_PTR f;
2593 Lisp_Object arg, oldval;
2594{
2595 x_set_name (f, arg, 1);
2596}
2597
2598/* This function should be called by Emacs redisplay code to set the
2599 name; names set this way will never override names set by the user's
2600 lisp code. */
25250031 2601void
f945b920
JB		 2602x_implicitly_set_name (f, arg, oldval)
2603 FRAME_PTR f;
2604 Lisp_Object arg, oldval;
2605{
2606 x_set_name (f, arg, 0);
01f1ba30 2607}
943b580d
RS		 2608\f
2609/* Change the title of frame F to NAME.
2610 If NAME is nil, use the frame name as the title.
01f1ba30 2611
943b580d
RS		 2612 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2613 name; if NAME is a string, set F's name to NAME and set
2614 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2615
2616 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2617 suggesting a new name, which lisp code should override; if
2618 F->explicit_name is set, ignore the new name; otherwise, set it. */
2619
2620void
d62c8769 2621x_set_title (f, name, old_name)
943b580d 2622 struct frame *f;
d62c8769 2623 Lisp_Object name, old_name;
943b580d
RS		 2624{
2625 /* Don't change the title if it's already NAME. */
2626 if (EQ (name, f->title))
2627 return;
2628
2629 update_mode_lines = 1;
2630
2631 f->title = name;
2632
2633 if (NILP (name))
2634 name = f->name;
beb403b3 2635 else
b7826503 2636 CHECK_STRING (name);
943b580d
RS		 2637
2638 if (FRAME_X_WINDOW (f))
2639 {
2640 BLOCK_INPUT;
2641#ifdef HAVE_X11R4
2642 {
2643 XTextProperty text, icon;
d60660d6 2644 int bytes, stringp;
11270583 2645 Lisp_Object coding_system;
943b580d 2646
869331ee 2647 coding_system = Qcompound_text;
3201ea57 2648 /* See the comment "Note: Encoding strategy" in x_set_name. */
37323f34 2649 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
d60660d6 2650 text.encoding = (stringp ? XA_STRING
96db09e4 2651 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
943b580d 2652 text.format = 8;
96db09e4 2653 text.nitems = bytes;
943b580d 2654
96db09e4
KH		 2655 if (NILP (f->icon_name))
2656 {
2657 icon = text;
2658 }
2659 else
2660 {
3201ea57 2661 /* See the comment "Note: Encoding strategy" in x_set_name. */
37323f34 2662 icon.value = x_encode_text (f->icon_name, coding_system, 0,
d60660d6
KH		 2663 &bytes, &stringp);
2664 icon.encoding = (stringp ? XA_STRING
96db09e4
KH		 2665 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2666 icon.format = 8;
2667 icon.nitems = bytes;
2668 }
943b580d
RS		 2669#ifdef USE_X_TOOLKIT
2670 XSetWMName (FRAME_X_DISPLAY (f),
2671 XtWindow (f->output_data.x->widget), &text);
2672 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2673 &icon);
2674#else /* not USE_X_TOOLKIT */
488dd4c4
JD		 2675#ifdef USE_GTK
2676 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2677 SDATA (name));
2678 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2679 &icon);
2680#else /* not USE_GTK */
943b580d
RS		 2681 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2682 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
488dd4c4 2683#endif /* not USE_GTK */
943b580d 2684#endif /* not USE_X_TOOLKIT */
96db09e4 2685 if (!NILP (f->icon_name)
1b49bf99 2686 && icon.value != (unsigned char *) SDATA (f->icon_name))
96db09e4 2687 xfree (icon.value);
1b49bf99 2688 if (text.value != (unsigned char *) SDATA (name))
96db09e4 2689 xfree (text.value);
943b580d
RS		 2690 }
2691#else /* not HAVE_X11R4 */
2692 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
d5db4077 2693 SDATA (name));
943b580d 2694 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
d5db4077 2695 SDATA (name));
943b580d
RS		 2696#endif /* not HAVE_X11R4 */
2697 UNBLOCK_INPUT;
2698 }
2699}
2700\f
01f1ba30 2701void
f676886a
JB		 2702x_set_autoraise (f, arg, oldval)
2703 struct frame *f;
01f1ba30
JB		 2704 Lisp_Object arg, oldval;
2705{
f676886a 2706 f->auto_raise = !EQ (Qnil, arg);
01f1ba30
JB		 2707}
2708
2709void
f676886a
JB		 2710x_set_autolower (f, arg, oldval)
2711 struct frame *f;
01f1ba30
JB		 2712 Lisp_Object arg, oldval;
2713{
f676886a 2714 f->auto_lower = !EQ (Qnil, arg);
01f1ba30 2715}
179956b9 2716
eac358ef
KH		 2717void
2718x_set_unsplittable (f, arg, oldval)
2719 struct frame *f;
2720 Lisp_Object arg, oldval;
2721{
2722 f->no_split = !NILP (arg);
2723}
2724
179956b9 2725void
a3c87d4e 2726x_set_vertical_scroll_bars (f, arg, oldval)
179956b9
JB		 2727 struct frame *f;
2728 Lisp_Object arg, oldval;
2729{
1ab3d87e
RS		 2730 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2731 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2732 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2733 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
179956b9 2734 {
1ab3d87e
RS		 2735 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2736 = (NILP (arg)
2737 ? vertical_scroll_bar_none
2738 : EQ (Qright, arg)
488dd4c4 2739 ? vertical_scroll_bar_right
1ab3d87e 2740 : vertical_scroll_bar_left);
179956b9 2741
cf177271
JB		 2742 /* We set this parameter before creating the X window for the
2743 frame, so we can get the geometry right from the start.
2744 However, if the window hasn't been created yet, we shouldn't
2745 call x_set_window_size. */
2746 if (FRAME_X_WINDOW (f))
363f7e15 2747 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
8938a4fb 2748 do_pending_window_change (0);
179956b9
JB		 2749 }
2750}
4701395c
KH		 2751
2752void
2753x_set_scroll_bar_width (f, arg, oldval)
2754 struct frame *f;
2755 Lisp_Object arg, oldval;
2756{
a672c74d
RS		 2757 int wid = FONT_WIDTH (f->output_data.x->font);
2758
dff9a538
KH		 2759 if (NILP (arg))
2760 {
c6e9d03b
GM		 2761#ifdef USE_TOOLKIT_SCROLL_BARS
2762 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
333b20bb
GM		 2763 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2764 FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2765 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
2766#else
2767 /* Make the actual width at least 14 pixels and a multiple of a
2768 character width. */
a672c74d 2769 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
488dd4c4 2770
333b20bb
GM		 2771 /* Use all of that space (aside from required margins) for the
2772 scroll bar. */
dff9a538 2773 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
333b20bb 2774#endif
a672c74d 2775
a90ab372
RS		 2776 if (FRAME_X_WINDOW (f))
2777 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
8938a4fb 2778 do_pending_window_change (0);
dff9a538
KH		 2779 }
2780 else if (INTEGERP (arg) && XINT (arg) > 0
2781 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
4701395c 2782 {
09d8c7ac
RS		 2783 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2784 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
0a26b136 2785
4701395c
KH		 2786 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2787 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2788 if (FRAME_X_WINDOW (f))
2789 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2790 }
dca97592 2791
8938a4fb 2792 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
333b20bb
GM		 2793 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2794 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
4701395c 2795}
333b20bb
GM		 2796
2797
01f1ba30 2798\f
f676886a 2799/* Subroutines of creating an X frame. */
01f1ba30 2800
b7975ee4
KH		 2801/* Make sure that Vx_resource_name is set to a reasonable value.
2802 Fix it up, or set it to `emacs' if it is too hopeless. */
2803
d387c960
JB		 2804static void
2805validate_x_resource_name ()
2806{
333b20bb 2807 int len = 0;
0e78b377
RS		 2808 /* Number of valid characters in the resource name. */
2809 int good_count = 0;
2810 /* Number of invalid characters in the resource name. */
2811 int bad_count = 0;
2812 Lisp_Object new;
2813 int i;
2814
498e9ac3
RS		 2815 if (!STRINGP (Vx_resource_class))
2816 Vx_resource_class = build_string (EMACS_CLASS);
2817
cf204347
RS		 2818 if (STRINGP (Vx_resource_name))
2819 {
d5db4077 2820 unsigned char *p = SDATA (Vx_resource_name);
cf204347
RS		 2821 int i;
2822
d5db4077 2823 len = SBYTES (Vx_resource_name);
0e78b377
RS		 2824
2825 /* Only letters, digits, - and _ are valid in resource names.
2826 Count the valid characters and count the invalid ones. */
cf204347
RS		 2827 for (i = 0; i < len; i++)
2828 {
2829 int c = p[i];
2830 if (! ((c >= 'a' && c <= 'z')
2831 || (c >= 'A' && c <= 'Z')
2832 || (c >= '0' && c <= '9')
2833 || c == '-' || c == '_'))
0e78b377
RS		 2834 bad_count++;
2835 else
2836 good_count++;
cf204347
RS		 2837 }
2838 }
2839 else
0e78b377
RS		 2840 /* Not a string => completely invalid. */
2841 bad_count = 5, good_count = 0;
2842
2843 /* If name is valid already, return. */
2844 if (bad_count == 0)
2845 return;
2846
2847 /* If name is entirely invalid, or nearly so, use `emacs'. */
2848 if (good_count == 0
2849 || (good_count == 1 && bad_count > 0))
2850 {
b7975ee4 2851 Vx_resource_name = build_string ("emacs");
0e78b377
RS		 2852 return;
2853 }
2854
2855 /* Name is partly valid. Copy it and replace the invalid characters
2856 with underscores. */
2857
2858 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2859
2860 for (i = 0; i < len; i++)
2861 {
d5db4077 2862 int c = SREF (new, i);
0e78b377
RS		 2863 if (! ((c >= 'a' && c <= 'z')
2864 || (c >= 'A' && c <= 'Z')
2865 || (c >= '0' && c <= '9')
2866 || c == '-' || c == '_'))
b06a00fb 2867 SSET (new, i, '_');
0e78b377 2868 }
d387c960
JB		 2869}
2870
2871
01f1ba30 2872extern char *x_get_string_resource ();
01f1ba30 2873
cf177271 2874DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
03265352 2875 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
c061c855
GM		 2876This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2877class, where INSTANCE is the name under which Emacs was invoked, or
2878the name specified by the `-name' or `-rn' command-line arguments.
2879
2880The optional arguments COMPONENT and SUBCLASS add to the key and the
2881class, respectively. You must specify both of them or neither.
2882If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
7ee72033
MB		 2883and the class is `Emacs.CLASS.SUBCLASS'. */)
2884 (attribute, class, component, subclass)
cf177271 2885 Lisp_Object attribute, class, component, subclass;
01f1ba30
JB		 2886{
2887 register char *value;
2888 char *name_key;
2889 char *class_key;
2890
11ae94fe
RS		 2891 check_x ();
2892
b7826503
PJ		 2893 CHECK_STRING (attribute);
2894 CHECK_STRING (class);
cf177271 2895
8fabe6f4 2896 if (!NILP (component))
b7826503 2897 CHECK_STRING (component);
8fabe6f4 2898 if (!NILP (subclass))
b7826503 2899 CHECK_STRING (subclass);
8fabe6f4
RS		 2900 if (NILP (component) != NILP (subclass))
2901 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2902
d387c960
JB		 2903 validate_x_resource_name ();
2904
b7975ee4
KH		 2905 /* Allocate space for the components, the dots which separate them,
2906 and the final '\0'. Make them big enough for the worst case. */
d5db4077 2907 name_key = (char *) alloca (SBYTES (Vx_resource_name)
b7975ee4 2908 + (STRINGP (component)
d5db4077
KR		 2909 ? SBYTES (component) : 0)
2910 + SBYTES (attribute)
b7975ee4
KH		 2911 + 3);
2912
d5db4077
KR		 2913 class_key = (char *) alloca (SBYTES (Vx_resource_class)
2914 + SBYTES (class)
b7975ee4 2915 + (STRINGP (subclass)
d5db4077 2916 ? SBYTES (subclass) : 0)
b7975ee4
KH		 2917 + 3);
2918
2919 /* Start with emacs.FRAMENAME for the name (the specific one)
2920 and with `Emacs' for the class key (the general one). */
d5db4077
KR		 2921 strcpy (name_key, SDATA (Vx_resource_name));
2922 strcpy (class_key, SDATA (Vx_resource_class));
b7975ee4
KH		 2923
2924 strcat (class_key, ".");
d5db4077 2925 strcat (class_key, SDATA (class));
b7975ee4
KH		 2926
2927 if (!NILP (component))
01f1ba30 2928 {
b7975ee4 2929 strcat (class_key, ".");
d5db4077 2930 strcat (class_key, SDATA (subclass));
b7975ee4
KH		 2931
2932 strcat (name_key, ".");
d5db4077 2933 strcat (name_key, SDATA (component));
01f1ba30
JB		 2934 }
2935
b7975ee4 2936 strcat (name_key, ".");
d5db4077 2937 strcat (name_key, SDATA (attribute));
b7975ee4 2938
b9dc4443
RS		 2939 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2940 name_key, class_key);
01f1ba30
JB		 2941
2942 if (value != (char *) 0)
2943 return build_string (value);
2944 else
2945 return Qnil;
2946}
2947
abb4b7ec
RS		 2948/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2949
333b20bb 2950Lisp_Object
abb4b7ec
RS		 2951display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2952 struct x_display_info *dpyinfo;
2953 Lisp_Object attribute, class, component, subclass;
2954{
2955 register char *value;
2956 char *name_key;
2957 char *class_key;
2958
b7826503
PJ		 2959 CHECK_STRING (attribute);
2960 CHECK_STRING (class);
abb4b7ec
RS		 2961
2962 if (!NILP (component))
b7826503 2963 CHECK_STRING (component);
abb4b7ec 2964 if (!NILP (subclass))
b7826503 2965 CHECK_STRING (subclass);
abb4b7ec
RS		 2966 if (NILP (component) != NILP (subclass))
2967 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2968
2969 validate_x_resource_name ();
2970
2971 /* Allocate space for the components, the dots which separate them,
2972 and the final '\0'. Make them big enough for the worst case. */
d5db4077 2973 name_key = (char *) alloca (SBYTES (Vx_resource_name)
abb4b7ec 2974 + (STRINGP (component)
d5db4077
KR		 2975 ? SBYTES (component) : 0)
2976 + SBYTES (attribute)
abb4b7ec
RS		 2977 + 3);
2978
d5db4077
KR		 2979 class_key = (char *) alloca (SBYTES (Vx_resource_class)
2980 + SBYTES (class)
abb4b7ec 2981 + (STRINGP (subclass)
d5db4077 2982 ? SBYTES (subclass) : 0)
abb4b7ec
RS		 2983 + 3);
2984
2985 /* Start with emacs.FRAMENAME for the name (the specific one)
2986 and with `Emacs' for the class key (the general one). */
d5db4077
KR		 2987 strcpy (name_key, SDATA (Vx_resource_name));
2988 strcpy (class_key, SDATA (Vx_resource_class));
abb4b7ec
RS		 2989
2990 strcat (class_key, ".");
d5db4077 2991 strcat (class_key, SDATA (class));
abb4b7ec
RS		 2992
2993 if (!NILP (component))
2994 {
2995 strcat (class_key, ".");
d5db4077 2996 strcat (class_key, SDATA (subclass));
abb4b7ec
RS		 2997
2998 strcat (name_key, ".");
d5db4077 2999 strcat (name_key, SDATA (component));
abb4b7ec
RS		 3000 }
3001
3002 strcat (name_key, ".");
d5db4077 3003 strcat (name_key, SDATA (attribute));
abb4b7ec
RS		 3004
3005 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
3006
3007 if (value != (char *) 0)
3008 return build_string (value);
3009 else
3010 return Qnil;
3011}
3012
3402e1a4
RS		 3013/* Used when C code wants a resource value. */
3014
3015char *
3016x_get_resource_string (attribute, class)
3017 char *attribute, *class;
3018{
3402e1a4
RS		 3019 char *name_key;
3020 char *class_key;
0fe92f72 3021 struct frame *sf = SELECTED_FRAME ();
3402e1a4
RS		 3022
3023 /* Allocate space for the components, the dots which separate them,
3024 and the final '\0'. */
d5db4077 3025 name_key = (char *) alloca (SBYTES (Vinvocation_name)
3402e1a4
RS		 3026 + strlen (attribute) + 2);
3027 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3028 + strlen (class) + 2);
3029
3030 sprintf (name_key, "%s.%s",
d5db4077 3031 SDATA (Vinvocation_name),
3402e1a4
RS		 3032 attribute);
3033 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3034
0fe92f72 3035 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
b9dc4443 3036 name_key, class_key);
3402e1a4
RS		 3037}
3038
60fb3ee1
JB		 3039/* Types we might convert a resource string into. */
3040enum resource_types
333b20bb
GM		 3041{
3042 RES_TYPE_NUMBER,
d62c8769 3043 RES_TYPE_FLOAT,
333b20bb
GM		 3044 RES_TYPE_BOOLEAN,
3045 RES_TYPE_STRING,
3046 RES_TYPE_SYMBOL
3047};
60fb3ee1 3048
01f1ba30 3049/* Return the value of parameter PARAM.
60fb3ee1 3050
f676886a 3051 First search ALIST, then Vdefault_frame_alist, then the X defaults
cf177271 3052 database, using ATTRIBUTE as the attribute name and CLASS as its class.
60fb3ee1
JB		 3053
3054 Convert the resource to the type specified by desired_type.
3055
f9942c9e
JB		 3056 If no default is specified, return Qunbound. If you call
3057 x_get_arg, make sure you deal with Qunbound in a reasonable way,
a59e4f3d 3058 and don't let it get stored in any Lisp-visible variables! */
01f1ba30
JB		 3059
3060static Lisp_Object
abb4b7ec
RS		 3061x_get_arg (dpyinfo, alist, param, attribute, class, type)
3062 struct x_display_info *dpyinfo;
3c254570 3063 Lisp_Object alist, param;
60fb3ee1 3064 char *attribute;
cf177271 3065 char *class;
60fb3ee1 3066 enum resource_types type;
01f1ba30
JB		 3067{
3068 register Lisp_Object tem;
3069
3070 tem = Fassq (param, alist);
3071 if (EQ (tem, Qnil))
f676886a 3072 tem = Fassq (param, Vdefault_frame_alist);
f9942c9e 3073 if (EQ (tem, Qnil))
01f1ba30 3074 {
60fb3ee1 3075
f9942c9e 3076 if (attribute)
60fb3ee1 3077 {
abb4b7ec
RS		 3078 tem = display_x_get_resource (dpyinfo,
3079 build_string (attribute),
3080 build_string (class),
3081 Qnil, Qnil);
f9942c9e
JB		 3082
3083 if (NILP (tem))
3084 return Qunbound;
3085
3086 switch (type)
3087 {
333b20bb 3088 case RES_TYPE_NUMBER:
d5db4077 3089 return make_number (atoi (SDATA (tem)));
f9942c9e 3090
d62c8769 3091 case RES_TYPE_FLOAT:
d5db4077 3092 return make_float (atof (SDATA (tem)));
d62c8769 3093
333b20bb 3094 case RES_TYPE_BOOLEAN:
f9942c9e 3095 tem = Fdowncase (tem);
d5db4077
KR		 3096 if (!strcmp (SDATA (tem), "on")
3097 || !strcmp (SDATA (tem), "true"))
f9942c9e 3098 return Qt;
488dd4c4 3099 else
f9942c9e
JB		 3100 return Qnil;
3101
333b20bb 3102 case RES_TYPE_STRING:
f9942c9e
JB		 3103 return tem;
3104
333b20bb 3105 case RES_TYPE_SYMBOL:
49795535
JB		 3106 /* As a special case, we map the values `true' and `on'
3107 to Qt, and `false' and `off' to Qnil. */
3108 {
98381190
KH		 3109 Lisp_Object lower;
3110 lower = Fdowncase (tem);
d5db4077
KR		 3111 if (!strcmp (SDATA (lower), "on")
3112 || !strcmp (SDATA (lower), "true"))
49795535 3113 return Qt;
d5db4077
KR		 3114 else if (!strcmp (SDATA (lower), "off")
3115 || !strcmp (SDATA (lower), "false"))
49795535
JB		 3116 return Qnil;
3117 else
89032215 3118 return Fintern (tem, Qnil);
49795535 3119 }
f945b920 3120
f9942c9e
JB		 3121 default:
3122 abort ();
3123 }
60fb3ee1 3124 }
f9942c9e
JB		 3125 else
3126 return Qunbound;
01f1ba30
JB		 3127 }
3128 return Fcdr (tem);
3129}
3130
e4f79258
RS		 3131/* Like x_get_arg, but also record the value in f->param_alist. */
3132
3133static Lisp_Object
3134x_get_and_record_arg (f, alist, param, attribute, class, type)
3135 struct frame *f;
3136 Lisp_Object alist, param;
3137 char *attribute;
3138 char *class;
3139 enum resource_types type;
3140{
3141 Lisp_Object value;
3142
abb4b7ec
RS		 3143 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
3144 attribute, class, type);
e4f79258
RS		 3145 if (! NILP (value))
3146 store_frame_param (f, param, value);
3147
3148 return value;
3149}
3150
f676886a 3151/* Record in frame F the specified or default value according to ALIST
e8cc313b
KH		 3152 of the parameter named PROP (a Lisp symbol).
3153 If no value is specified for PROP, look for an X default for XPROP
f676886a 3154 on the frame named NAME.
01f1ba30
JB		 3155 If that is not found either, use the value DEFLT. */
3156
3157static Lisp_Object
cf177271 3158x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
f676886a 3159 struct frame *f;
01f1ba30 3160 Lisp_Object alist;
f9942c9e 3161 Lisp_Object prop;
01f1ba30
JB		 3162 Lisp_Object deflt;
3163 char *xprop;
cf177271 3164 char *xclass;
60fb3ee1 3165 enum resource_types type;
01f1ba30 3166{
01f1ba30
JB		 3167 Lisp_Object tem;
3168
abb4b7ec 3169 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
f9942c9e 3170 if (EQ (tem, Qunbound))
01f1ba30 3171 tem = deflt;
f9942c9e 3172 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
01f1ba30
JB		 3173 return tem;
3174}
333b20bb
GM		 3175
3176
3177/* Record in frame F the specified or default value according to ALIST
3178 of the parameter named PROP (a Lisp symbol). If no value is
3179 specified for PROP, look for an X default for XPROP on the frame
3180 named NAME. If that is not found either, use the value DEFLT. */
3181
3182static Lisp_Object
3183x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
3184 foreground_p)
3185 struct frame *f;
3186 Lisp_Object alist;
3187 Lisp_Object prop;
3188 char *xprop;
3189 char *xclass;
3190 int foreground_p;
3191{
3192 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3193 Lisp_Object tem;
3194
3195 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
3196 if (EQ (tem, Qunbound))
3197 {
3198#ifdef USE_TOOLKIT_SCROLL_BARS
3199
3200 /* See if an X resource for the scroll bar color has been
3201 specified. */
3202 tem = display_x_get_resource (dpyinfo,
3203 build_string (foreground_p
3204 ? "foreground"
3205 : "background"),
c0ec53ad 3206 empty_string,
333b20bb 3207 build_string ("verticalScrollBar"),
c0ec53ad 3208 empty_string);
333b20bb
GM		 3209 if (!STRINGP (tem))
3210 {
3211 /* If nothing has been specified, scroll bars will use a
3212 toolkit-dependent default. Because these defaults are
3213 difficult to get at without actually creating a scroll
3214 bar, use nil to indicate that no color has been
3215 specified. */
3216 tem = Qnil;
3217 }
488dd4c4 3218
333b20bb 3219#else /* not USE_TOOLKIT_SCROLL_BARS */
488dd4c4 3220
333b20bb 3221 tem = Qnil;
488dd4c4 3222
333b20bb
GM		 3223#endif /* not USE_TOOLKIT_SCROLL_BARS */
3224 }
3225
3226 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3227 return tem;
3228}
3229
3230
01f1ba30 3231\f
8af1d7ca 3232DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
7ee72033 3233 doc: /* Parse an X-style geometry string STRING.
c061c855
GM		 3234Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3235The properties returned may include `top', `left', `height', and `width'.
3236The value of `left' or `top' may be an integer,
3237or a list (+ N) meaning N pixels relative to top/left corner,
7ee72033
MB		 3238or a list (- N) meaning -N pixels relative to bottom/right corner. */)
3239 (string)
a6605e5c 3240 Lisp_Object string;
01f1ba30
JB		 3241{
3242 int geometry, x, y;
3243 unsigned int width, height;
f83f10ba 3244 Lisp_Object result;
01f1ba30 3245
b7826503 3246 CHECK_STRING (string);
01f1ba30 3247
d5db4077 3248 geometry = XParseGeometry ((char *) SDATA (string),
01f1ba30
JB		 3249 &x, &y, &width, &height);
3250
f83f10ba
RS		 3251#if 0
3252 if (!!(geometry & XValue) != !!(geometry & YValue))
3253 error ("Must specify both x and y position, or neither");
3254#endif
3255
3256 result = Qnil;
3257 if (geometry & XValue)
01f1ba30 3258 {
f83f10ba
RS		 3259 Lisp_Object element;
3260
e1d962d7
RS		 3261 if (x >= 0 && (geometry & XNegative))
3262 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3263 else if (x < 0 && ! (geometry & XNegative))
3264 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
f83f10ba
RS		 3265 else
3266 element = Fcons (Qleft, make_number (x));
3267 result = Fcons (element, result);
3268 }
3269
3270 if (geometry & YValue)
3271 {
3272 Lisp_Object element;
3273
e1d962d7
RS		 3274 if (y >= 0 && (geometry & YNegative))
3275 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3276 else if (y < 0 && ! (geometry & YNegative))
3277 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
f83f10ba
RS		 3278 else
3279 element = Fcons (Qtop, make_number (y));
3280 result = Fcons (element, result);
01f1ba30 3281 }
f83f10ba
RS		 3282
3283 if (geometry & WidthValue)
3284 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3285 if (geometry & HeightValue)
3286 result = Fcons (Fcons (Qheight, make_number (height)), result);
3287
3288 return result;
01f1ba30
JB		 3289}
3290
01f1ba30 3291/* Calculate the desired size and position of this window,
f83f10ba 3292 and return the flags saying which aspects were specified.
8fc2766b
RS		 3293
3294 This function does not make the coordinates positive. */
01f1ba30
JB		 3295
3296#define DEFAULT_ROWS 40
3297#define DEFAULT_COLS 80
3298
f9942c9e 3299static int
f676886a
JB		 3300x_figure_window_size (f, parms)
3301 struct frame *f;
01f1ba30
JB		 3302 Lisp_Object parms;
3303{
4fe1de12 3304 register Lisp_Object tem0, tem1, tem2;
01f1ba30 3305 long window_prompting = 0;
abb4b7ec 3306 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
01f1ba30
JB		 3307
3308 /* Default values if we fall through.
3309 Actually, if that happens we should get
b9dc4443 3310 window manager prompting. */
1ab3d87e 3311 SET_FRAME_WIDTH (f, DEFAULT_COLS);
f676886a 3312 f->height = DEFAULT_ROWS;
bd0b85c3
RS		 3313 /* Window managers expect that if program-specified
3314 positions are not (0,0), they're intentional, not defaults. */
7556890b
RS		 3315 f->output_data.x->top_pos = 0;
3316 f->output_data.x->left_pos = 0;
01f1ba30 3317
333b20bb
GM		 3318 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3319 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3320 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
f83f10ba 3321 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30 3322 {
f83f10ba
RS		 3323 if (!EQ (tem0, Qunbound))
3324 {
b7826503 3325 CHECK_NUMBER (tem0);
f83f10ba
RS		 3326 f->height = XINT (tem0);
3327 }
3328 if (!EQ (tem1, Qunbound))
3329 {
b7826503 3330 CHECK_NUMBER (tem1);
1ab3d87e 3331 SET_FRAME_WIDTH (f, XINT (tem1));
f83f10ba
RS		 3332 }
3333 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4fe1de12
RS		 3334 window_prompting |= USSize;
3335 else
3336 window_prompting |= PSize;
01f1ba30 3337 }
01f1ba30 3338
7556890b 3339 f->output_data.x->vertical_scroll_bar_extra
a444c70b
KH		 3340 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3341 ? 0
7556890b 3342 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
b3ba0aa8
KS		 3343
3344 x_compute_fringe_widths (f, 0);
3345
7556890b
RS		 3346 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3347 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
01f1ba30 3348
333b20bb
GM		 3349 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3350 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3351 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
f83f10ba 3352 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30 3353 {
f83f10ba
RS		 3354 if (EQ (tem0, Qminus))
3355 {
7556890b 3356 f->output_data.x->top_pos = 0;
f83f10ba
RS		 3357 window_prompting |= YNegative;
3358 }
8e713be6
KR		 3359 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3360 && CONSP (XCDR (tem0))
3361 && INTEGERP (XCAR (XCDR (tem0))))
e1d962d7 3362 {
8e713be6 3363 f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
e1d962d7
RS		 3364 window_prompting |= YNegative;
3365 }
8e713be6
KR		 3366 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3367 && CONSP (XCDR (tem0))
3368 && INTEGERP (XCAR (XCDR (tem0))))
e1d962d7 3369 {
8e713be6 3370 f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
e1d962d7 3371 }
f83f10ba 3372 else if (EQ (tem0, Qunbound))
7556890b 3373 f->output_data.x->top_pos = 0;
f83f10ba
RS		 3374 else
3375 {
b7826503 3376 CHECK_NUMBER (tem0);
7556890b
RS		 3377 f->output_data.x->top_pos = XINT (tem0);
3378 if (f->output_data.x->top_pos < 0)
f83f10ba
RS		 3379 window_prompting |= YNegative;
3380 }
3381
3382 if (EQ (tem1, Qminus))
3383 {
7556890b 3384 f->output_data.x->left_pos = 0;
f83f10ba
RS		 3385 window_prompting |= XNegative;
3386 }
8e713be6
KR		 3387 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3388 && CONSP (XCDR (tem1))
3389 && INTEGERP (XCAR (XCDR (tem1))))
e1d962d7 3390 {
8e713be6 3391 f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
e1d962d7
RS		 3392 window_prompting |= XNegative;
3393 }
8e713be6
KR		 3394 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3395 && CONSP (XCDR (tem1))
3396 && INTEGERP (XCAR (XCDR (tem1))))
e1d962d7 3397 {
8e713be6 3398 f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
e1d962d7 3399 }
f83f10ba 3400 else if (EQ (tem1, Qunbound))
7556890b 3401 f->output_data.x->left_pos = 0;
f83f10ba
RS		 3402 else
3403 {
b7826503 3404 CHECK_NUMBER (tem1);
7556890b
RS		 3405 f->output_data.x->left_pos = XINT (tem1);
3406 if (f->output_data.x->left_pos < 0)
f83f10ba
RS		 3407 window_prompting |= XNegative;
3408 }
3409
c3724dc2 3410 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4fe1de12
RS		 3411 window_prompting |= USPosition;
3412 else
3413 window_prompting |= PPosition;
01f1ba30 3414 }
f83f10ba 3415
49d41073
EZ		 3416 if (f->output_data.x->want_fullscreen != FULLSCREEN_NONE)
3417 {
3418 int left, top;
3419 int width, height;
488dd4c4 3420
49d41073
EZ		 3421 /* It takes both for some WM:s to place it where we want */
3422 window_prompting = USPosition | PPosition;
3423 x_fullscreen_adjust (f, &width, &height, &top, &left);
3424 f->width = width;
3425 f->height = height;
3426 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3427 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
3428 f->output_data.x->left_pos = left;
3429 f->output_data.x->top_pos = top;
3430 }
488dd4c4 3431
739f2f53 3432 return window_prompting;
01f1ba30
JB		 3433}
3434
f58534a3
RS		 3435#if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3436
3437Status
3438XSetWMProtocols (dpy, w, protocols, count)
3439 Display *dpy;
3440 Window w;
3441 Atom *protocols;
3442 int count;
3443{
3444 Atom prop;
3445 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
3446 if (prop == None) return False;
3447 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
3448 (unsigned char *) protocols, count);
3449 return True;
3450}
9ef48a9d
RS		 3451#endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3452\f
3453#ifdef USE_X_TOOLKIT
3454
8e3d10a9
RS		 3455/* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3456 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
59aa6c90
RS		 3457 already be present because of the toolkit (Motif adds some of them,
3458 for example, but Xt doesn't). */
9ef48a9d
RS		 3459
3460static void
b9dc4443
RS		 3461hack_wm_protocols (f, widget)
3462 FRAME_PTR f;
9ef48a9d
RS		 3463 Widget widget;
3464{
3465 Display *dpy = XtDisplay (widget);
3466 Window w = XtWindow (widget);
3467 int need_delete = 1;
3468 int need_focus = 1;
59aa6c90 3469 int need_save = 1;
9ef48a9d
RS		 3470
3471 BLOCK_INPUT;
3472 {
3473 Atom type, *atoms = 0;
3474 int format = 0;
3475 unsigned long nitems = 0;
3476 unsigned long bytes_after;
3477
270958e8
KH		 3478 if ((XGetWindowProperty (dpy, w,
3479 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
34d5ae1e 3480 (long)0, (long)100, False, XA_ATOM,
270958e8
KH		 3481 &type, &format, &nitems, &bytes_after,
3482 (unsigned char **) &atoms)
3483 == Success)
9ef48a9d
RS		 3484 && format == 32 && type == XA_ATOM)
3485 while (nitems > 0)
3486 {
3487 nitems--;
b9dc4443
RS		 3488 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
3489 need_delete = 0;
3490 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
3491 need_focus = 0;
3492 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
3493 need_save = 0;
9ef48a9d
RS		 3494 }
3495 if (atoms) XFree ((char *) atoms);
3496 }
3497 {
3498 Atom props [10];
3499 int count = 0;
b9dc4443
RS		 3500 if (need_delete)
3501 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3502 if (need_focus)
3503 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
3504 if (need_save)
3505 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
9ef48a9d 3506 if (count)
b9dc4443
RS		 3507 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3508 XA_ATOM, 32, PropModeAppend,
9ef48a9d
RS		 3509 (unsigned char *) props, count);
3510 }
3511 UNBLOCK_INPUT;
3512}
3513#endif
86779fac
GM		 3514
3515
5a7df7d7
GM		 3516\f
3517/* Support routines for XIC (X Input Context). */
86779fac 3518
5a7df7d7
GM		 3519#ifdef HAVE_X_I18N
3520
3521static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
3522static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
3523
3524
3525/* Supported XIM styles, ordered by preferenc. */
3526
3527static XIMStyle supported_xim_styles[] =
3528{
3529 XIMPreeditPosition | XIMStatusArea,
3530 XIMPreeditPosition | XIMStatusNothing,
3531 XIMPreeditPosition | XIMStatusNone,
3532 XIMPreeditNothing | XIMStatusArea,
3533 XIMPreeditNothing | XIMStatusNothing,
3534 XIMPreeditNothing | XIMStatusNone,
3535 XIMPreeditNone | XIMStatusArea,
3536 XIMPreeditNone | XIMStatusNothing,
3537 XIMPreeditNone | XIMStatusNone,
3538 0,
3539};
3540
3541
3542/* Create an X fontset on frame F with base font name
3543 BASE_FONTNAME.. */
3544
3545static XFontSet
3546xic_create_xfontset (f, base_fontname)
86779fac 3547 struct frame *f;
5a7df7d7 3548 char *base_fontname;
86779fac 3549{
5a7df7d7
GM		 3550 XFontSet xfs;
3551 char **missing_list;
3552 int missing_count;
3553 char *def_string;
488dd4c4 3554
5a7df7d7
GM		 3555 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
3556 base_fontname, &missing_list,
3557 &missing_count, &def_string);
3558 if (missing_list)
3559 XFreeStringList (missing_list);
488dd4c4 3560
5a7df7d7
GM		 3561 /* No need to free def_string. */
3562 return xfs;
3563}
3564
3565
3566/* Value is the best input style, given user preferences USER (already
3567 checked to be supported by Emacs), and styles supported by the
3568 input method XIM. */
3569
3570static XIMStyle
3571best_xim_style (user, xim)
3572 XIMStyles *user;
3573 XIMStyles *xim;
3574{
3575 int i, j;
3576
3577 for (i = 0; i < user->count_styles; ++i)
3578 for (j = 0; j < xim->count_styles; ++j)
3579 if (user->supported_styles[i] == xim->supported_styles[j])
3580 return user->supported_styles[i];
3581
3582 /* Return the default style. */
3583 return XIMPreeditNothing | XIMStatusNothing;
3584}
3585
3586/* Create XIC for frame F. */
3587
5df79d3d
GM		 3588static XIMStyle xic_style;
3589
5a7df7d7
GM		 3590void
3591create_frame_xic (f)
3592 struct frame *f;
3593{
5a7df7d7
GM		 3594 XIM xim;
3595 XIC xic = NULL;
3596 XFontSet xfs = NULL;
86779fac 3597
5a7df7d7
GM		 3598 if (FRAME_XIC (f))
3599 return;
488dd4c4 3600
5a7df7d7
GM		 3601 xim = FRAME_X_XIM (f);
3602 if (xim)
3603 {
d9d57cb2
DL		 3604 XRectangle s_area;
3605 XPoint spot;
5a7df7d7
GM		 3606 XVaNestedList preedit_attr;
3607 XVaNestedList status_attr;
3608 char *base_fontname;
3609 int fontset;
3610
d9d57cb2
DL		 3611 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
3612 spot.x = 0; spot.y = 1;
5a7df7d7
GM		 3613 /* Create X fontset. */
3614 fontset = FRAME_FONTSET (f);
3615 if (fontset < 0)
3616 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3617 else
3618 {
6ecb43ce
KH		 3619 /* Determine the base fontname from the ASCII font name of
3620 FONTSET. */
d5db4077 3621 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
6ecb43ce 3622 char *p = ascii_font;
5a7df7d7 3623 int i;
6ecb43ce
KH		 3624
3625 for (i = 0; *p; p++)
3626 if (*p == '-') i++;
3627 if (i != 14)
3628 /* As the font name doesn't conform to XLFD, we can't
3629 modify it to get a suitable base fontname for the
3630 frame. */
3631 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3632 else
3633 {
3634 int len = strlen (ascii_font) + 1;
8ec8a5ec 3635 char *p1 = NULL;
6ecb43ce
KH		 3636
3637 for (i = 0, p = ascii_font; i < 8; p++)
3638 {
3639 if (*p == '-')
3640 {
3641 i++;
3642 if (i == 3)
3643 p1 = p + 1;
3644 }
3645 }
3646 base_fontname = (char *) alloca (len);
3647 bzero (base_fontname, len);
3648 strcpy (base_fontname, "-*-*-");
3649 bcopy (p1, base_fontname + 5, p - p1);
3650 strcat (base_fontname, "*-*-*-*-*-*-*");
3651 }
5a7df7d7
GM		 3652 }
3653 xfs = xic_create_xfontset (f, base_fontname);
86779fac 3654
5a7df7d7
GM		 3655 /* Determine XIC style. */
3656 if (xic_style == 0)
3657 {
3658 XIMStyles supported_list;
3659 supported_list.count_styles = (sizeof supported_xim_styles
3660 / sizeof supported_xim_styles[0]);
3661 supported_list.supported_styles = supported_xim_styles;
3662 xic_style = best_xim_style (&supported_list,
3663 FRAME_X_XIM_STYLES (f));
3664 }
86779fac 3665
5a7df7d7
GM		 3666 preedit_attr = XVaCreateNestedList (0,
3667 XNFontSet, xfs,
3668 XNForeground,
3669 FRAME_FOREGROUND_PIXEL (f),
3670 XNBackground,
3671 FRAME_BACKGROUND_PIXEL (f),
3672 (xic_style & XIMPreeditPosition
3673 ? XNSpotLocation
3674 : NULL),
3675 &spot,
3676 NULL);
3677 status_attr = XVaCreateNestedList (0,
3678 XNArea,
3679 &s_area,
3680 XNFontSet,
3681 xfs,
3682 XNForeground,
3683 FRAME_FOREGROUND_PIXEL (f),
3684 XNBackground,
3685 FRAME_BACKGROUND_PIXEL (f),
3686 NULL);
3687
3688 xic = XCreateIC (xim,
3689 XNInputStyle, xic_style,
3690 XNClientWindow, FRAME_X_WINDOW(f),
3691 XNFocusWindow, FRAME_X_WINDOW(f),
3692 XNStatusAttributes, status_attr,
3693 XNPreeditAttributes, preedit_attr,
3694 NULL);
3695 XFree (preedit_attr);
3696 XFree (status_attr);
3697 }
488dd4c4 3698
5a7df7d7
GM		 3699 FRAME_XIC (f) = xic;
3700 FRAME_XIC_STYLE (f) = xic_style;
3701 FRAME_XIC_FONTSET (f) = xfs;
86779fac
GM		 3702}
3703
5a7df7d7
GM		 3704
3705/* Destroy XIC and free XIC fontset of frame F, if any. */
3706
3707void
3708free_frame_xic (f)
3709 struct frame *f;
3710{
3711 if (FRAME_XIC (f) == NULL)
3712 return;
488dd4c4 3713
5a7df7d7
GM		 3714 XDestroyIC (FRAME_XIC (f));
3715 if (FRAME_XIC_FONTSET (f))
3716 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3717
3718 FRAME_XIC (f) = NULL;
3719 FRAME_XIC_FONTSET (f) = NULL;
3720}
3721
3722
3723/* Place preedit area for XIC of window W's frame to specified
3724 pixel position X/Y. X and Y are relative to window W. */
3725
3726void
3727xic_set_preeditarea (w, x, y)
3728 struct window *w;
3729 int x, y;
3730{
3731 struct frame *f = XFRAME (w->frame);
3732 XVaNestedList attr;
3733 XPoint spot;
488dd4c4 3734
5a7df7d7
GM		 3735 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
3736 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
3737 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
3738 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3739 XFree (attr);
3740}
3741
3742
3743/* Place status area for XIC in bottom right corner of frame F.. */
3744
3745void
3746xic_set_statusarea (f)
3747 struct frame *f;
3748{
3749 XIC xic = FRAME_XIC (f);
3750 XVaNestedList attr;
3751 XRectangle area;
3752 XRectangle *needed;
3753
3754 /* Negotiate geometry of status area. If input method has existing
3755 status area, use its current size. */
3756 area.x = area.y = area.width = area.height = 0;
3757 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
3758 XSetICValues (xic, XNStatusAttributes, attr, NULL);
3759 XFree (attr);
488dd4c4 3760
5a7df7d7
GM		 3761 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
3762 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3763 XFree (attr);
3764
3765 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
3766 {
3767 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
3768 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3769 XFree (attr);
3770 }
3771
3772 area.width = needed->width;
3773 area.height = needed->height;
3774 area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
3775 area.y = (PIXEL_HEIGHT (f) - area.height
488dd4c4
JD		 3776 - FRAME_MENUBAR_HEIGHT (f)
3777 - FRAME_TOOLBAR_HEIGHT (f)
3778 - FRAME_INTERNAL_BORDER_WIDTH (f));
5a7df7d7
GM		 3779 XFree (needed);
3780
3781 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
3782 XSetICValues(xic, XNStatusAttributes, attr, NULL);
3783 XFree (attr);
3784}
3785
3786
3787/* Set X fontset for XIC of frame F, using base font name
3788 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3789
3790void
3791xic_set_xfontset (f, base_fontname)
3792 struct frame *f;
3793 char *base_fontname;
3794{
3795 XVaNestedList attr;
3796 XFontSet xfs;
3797
3798 xfs = xic_create_xfontset (f, base_fontname);
3799
3800 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
3801 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
3802 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3803 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
3804 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
3805 XFree (attr);
488dd4c4 3806
5a7df7d7
GM		 3807 if (FRAME_XIC_FONTSET (f))
3808 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3809 FRAME_XIC_FONTSET (f) = xfs;
3810}
3811
3812#endif /* HAVE_X_I18N */
3813
3814
9ef48a9d 3815\f
8fc2766b
RS		 3816#ifdef USE_X_TOOLKIT
3817
3818/* Create and set up the X widget for frame F. */
f58534a3 3819
01f1ba30 3820static void
a7f7d550
FP		 3821x_window (f, window_prompting, minibuffer_only)
3822 struct frame *f;
3823 long window_prompting;
3824 int minibuffer_only;
01f1ba30 3825{
9ef48a9d 3826 XClassHint class_hints;
31ac8d8c
FP		 3827 XSetWindowAttributes attributes;
3828 unsigned long attribute_mask;
9ef48a9d
RS		 3829 Widget shell_widget;
3830 Widget pane_widget;
6c32dd68 3831 Widget frame_widget;
9ef48a9d
RS		 3832 Arg al [25];
3833 int ac;
3834
3835 BLOCK_INPUT;
3836
b7975ee4
KH		 3837 /* Use the resource name as the top-level widget name
3838 for looking up resources. Make a non-Lisp copy
3839 for the window manager, so GC relocation won't bother it.
3840
3841 Elsewhere we specify the window name for the window manager. */
488dd4c4 3842
cca176a0 3843 {
d5db4077 3844 char *str = (char *) SDATA (Vx_resource_name);
b7975ee4 3845 f->namebuf = (char *) xmalloc (strlen (str) + 1);
cca176a0
KH		 3846 strcpy (f->namebuf, str);
3847 }
9ef48a9d
RS		 3848
3849 ac = 0;
3850 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
3851 XtSetArg (al[ac], XtNinput, 1); ac++;
97787173 3852 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
7556890b 3853 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
9b2956e2
GM		 3854 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3855 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3856 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
cca176a0 3857 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
7a994728 3858 applicationShellWidgetClass,
82c90203 3859 FRAME_X_DISPLAY (f), al, ac);
9ef48a9d 3860
7556890b 3861 f->output_data.x->widget = shell_widget;
9ef48a9d
RS		 3862 /* maybe_set_screen_title_format (shell_widget); */
3863
6c32dd68
PR		 3864 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
3865 (widget_value *) NULL,
3866 shell_widget, False,
3867 (lw_callback) NULL,
3868 (lw_callback) NULL,
b6e11efd 3869 (lw_callback) NULL,
6c32dd68 3870 (lw_callback) NULL);
9ef48a9d 3871
9b2956e2
GM		 3872 ac = 0;
3873 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3874 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3875 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3876 XtSetValues (pane_widget, al, ac);
7556890b 3877 f->output_data.x->column_widget = pane_widget;
a7f7d550 3878
488dd4c4 3879 /* mappedWhenManaged to false tells to the paned window to not map/unmap
5e65b9ab 3880 the emacs screen when changing menubar. This reduces flickering. */
9ef48a9d
RS		 3881
3882 ac = 0;
3883 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3884 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
3885 XtSetArg (al[ac], XtNallowResize, 1); ac++;
3886 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
3887 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
9b2956e2
GM		 3888 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3889 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3890 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3891 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
3892 al, ac);
488dd4c4 3893
7556890b 3894 f->output_data.x->edit_widget = frame_widget;
488dd4c4
JD		 3895
3896 XtManageChild (frame_widget);
a7f7d550
FP		 3897
3898 /* Do some needed geometry management. */
3899 {
3900 int len;
3901 char *tem, shell_position[32];
3902 Arg al[2];
3903 int ac = 0;
5031cc10 3904 int extra_borders = 0;
488dd4c4 3905 int menubar_size
7556890b
RS		 3906 = (f->output_data.x->menubar_widget
3907 ? (f->output_data.x->menubar_widget->core.height
3908 + f->output_data.x->menubar_widget->core.border_width)
8fc2766b 3909 : 0);
a7f7d550 3910
f7008aff
RS		 3911#if 0 /* Experimentally, we now get the right results
3912 for -geometry -0-0 without this. 24 Aug 96, rms. */
01cbdba5
RS		 3913 if (FRAME_EXTERNAL_MENU_BAR (f))
3914 {
dd254b21 3915 Dimension ibw = 0;
01cbdba5
RS		 3916 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
3917 menubar_size += ibw;
3918 }
f7008aff 3919#endif
01cbdba5 3920
7556890b 3921 f->output_data.x->menubar_height = menubar_size;
00983aba 3922
440b0bfd 3923#ifndef USE_LUCID
5031cc10
KH		 3924 /* Motif seems to need this amount added to the sizes
3925 specified for the shell widget. The Athena/Lucid widgets don't.
3926 Both conclusions reached experimentally. -- rms. */
440b0bfd
RS		 3927 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
3928 &extra_borders, NULL);
3929 extra_borders *= 2;
3930#endif
5031cc10 3931
97787173
RS		 3932 /* Convert our geometry parameters into a geometry string
3933 and specify it.
3934 Note that we do not specify here whether the position
3935 is a user-specified or program-specified one.
3936 We pass that information later, in x_wm_set_size_hints. */
3937 {
7556890b 3938 int left = f->output_data.x->left_pos;
97787173 3939 int xneg = window_prompting & XNegative;
7556890b 3940 int top = f->output_data.x->top_pos;
97787173
RS		 3941 int yneg = window_prompting & YNegative;
3942 if (xneg)
3943 left = -left;
3944 if (yneg)
3945 top = -top;
c760f47e
KH		 3946
3947 if (window_prompting & USPosition)
5031cc10 3948 sprintf (shell_position, "=%dx%d%c%d%c%d",
488dd4c4 3949 PIXEL_WIDTH (f) + extra_borders,
5031cc10 3950 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
c760f47e
KH		 3951 (xneg ? '-' : '+'), left,
3952 (yneg ? '-' : '+'), top);
3953 else
5031cc10 3954 sprintf (shell_position, "=%dx%d",
488dd4c4 3955 PIXEL_WIDTH (f) + extra_borders,
5031cc10 3956 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
97787173
RS		 3957 }
3958
a7f7d550 3959 len = strlen (shell_position) + 1;
77110caa
RS		 3960 /* We don't free this because we don't know whether
3961 it is safe to free it while the frame exists.
3962 It isn't worth the trouble of arranging to free it
3963 when the frame is deleted. */
a7f7d550
FP		 3964 tem = (char *) xmalloc (len);
3965 strncpy (tem, shell_position, len);
3966 XtSetArg (al[ac], XtNgeometry, tem); ac++;
3967 XtSetValues (shell_widget, al, ac);
3968 }
3969
9ef48a9d
RS		 3970 XtManageChild (pane_widget);
3971 XtRealizeWidget (shell_widget);
3972
488dd4c4 3973 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
9ef48a9d
RS		 3974
3975 validate_x_resource_name ();
b7975ee4 3976
d5db4077
KR		 3977 class_hints.res_name = (char *) SDATA (Vx_resource_name);
3978 class_hints.res_class = (char *) SDATA (Vx_resource_class);
b9dc4443 3979 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
5a7df7d7
GM		 3980
3981#ifdef HAVE_X_I18N
3982 FRAME_XIC (f) = NULL;
4bd777b8 3983#ifdef USE_XIM
5a7df7d7 3984 create_frame_xic (f);
4bd777b8 3985#endif
5a7df7d7 3986#endif
64d16748 3987
7556890b
RS		 3988 f->output_data.x->wm_hints.input = True;
3989 f->output_data.x->wm_hints.flags |= InputHint;
b9dc4443 3990 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3991 &f->output_data.x->wm_hints);
b8228beb 3992
c4ec904f 3993 hack_wm_protocols (f, shell_widget);
9ef48a9d 3994
6c32dd68
PR		 3995#ifdef HACK_EDITRES
3996 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
3997#endif
3998
9ef48a9d 3999 /* Do a stupid property change to force the server to generate a
333b20bb 4000 PropertyNotify event so that the event_stream server timestamp will
9ef48a9d
RS		 4001 be initialized to something relevant to the time we created the window.
4002 */
6c32dd68 4003 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
b9dc4443
RS		 4004 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
4005 XA_ATOM, 32, PropModeAppend,
9ef48a9d
RS		 4006 (unsigned char*) NULL, 0);
4007
5a7df7d7 4008 /* Make all the standard events reach the Emacs frame. */
31ac8d8c 4009 attributes.event_mask = STANDARD_EVENT_SET;
5a7df7d7
GM		 4010
4011#ifdef HAVE_X_I18N
4012 if (FRAME_XIC (f))
4013 {
4014 /* XIM server might require some X events. */
4015 unsigned long fevent = NoEventMask;
4016 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
4017 attributes.event_mask |= fevent;
4018 }
4019#endif /* HAVE_X_I18N */
488dd4c4 4020
31ac8d8c
FP		 4021 attribute_mask = CWEventMask;
4022 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
4023 attribute_mask, &attributes);
4024
6c32dd68 4025 XtMapWidget (frame_widget);
9ef48a9d 4026
8fc2766b
RS		 4027 /* x_set_name normally ignores requests to set the name if the
4028 requested name is the same as the current name. This is the one
4029 place where that assumption isn't correct; f->name is set, but
4030 the X server hasn't been told. */
4031 {
4032 Lisp_Object name;
4033 int explicit = f->explicit_name;
4034
4035 f->explicit_name = 0;
4036 name = f->name;
4037 f->name = Qnil;
4038 x_set_name (f, name, explicit);
4039 }
4040
b9dc4443 4041 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 4042 f->output_data.x->text_cursor);
8fc2766b
RS		 4043
4044 UNBLOCK_INPUT;
4045
495fa05e
GM		 4046 /* This is a no-op, except under Motif. Make sure main areas are
4047 set to something reasonable, in case we get an error later. */
4048 lw_set_main_areas (pane_widget, 0, frame_widget);
8fc2766b
RS		 4049}
4050
9ef48a9d 4051#else /* not USE_X_TOOLKIT */
488dd4c4
JD		 4052#ifdef USE_GTK
4053void
4054x_window (f)
4055 FRAME_PTR f;
4056{
4057 if (! xg_create_frame_widgets (f))
4058 error ("Unable to create window");
1fcfb866
JD		 4059
4060#ifdef HAVE_X_I18N
4061 FRAME_XIC (f) = NULL;
4062#ifdef USE_XIM
4063 BLOCK_INPUT;
4064 create_frame_xic (f);
4065 if (FRAME_XIC (f))
4066 {
4067 /* XIM server might require some X events. */
4068 unsigned long fevent = NoEventMask;
4069 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
4070
4071 if (fevent != NoEventMask)
4072 {
4073 XSetWindowAttributes attributes;
4074 XWindowAttributes wattr;
4075 unsigned long attribute_mask;
4076
4077 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4078 &wattr);
4079 attributes.event_mask = wattr.your_event_mask | fevent;
4080 attribute_mask = CWEventMask;
4081 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4082 attribute_mask, &attributes);
4083 }
4084 }
4085 UNBLOCK_INPUT;
4086#endif
4087#endif
488dd4c4 4088}
9ef48a9d 4089
488dd4c4 4090#else /*! USE_GTK */
8fc2766b
RS		 4091/* Create and set up the X window for frame F. */
4092
201d8c78 4093void
8fc2766b
RS		 4094x_window (f)
4095 struct frame *f;
4096
4097{
4098 XClassHint class_hints;
4099 XSetWindowAttributes attributes;
4100 unsigned long attribute_mask;
4101
7556890b
RS		 4102 attributes.background_pixel = f->output_data.x->background_pixel;
4103 attributes.border_pixel = f->output_data.x->border_pixel;
01f1ba30
JB		 4104 attributes.bit_gravity = StaticGravity;
4105 attributes.backing_store = NotUseful;
4106 attributes.save_under = True;
4107 attributes.event_mask = STANDARD_EVENT_SET;
9b2956e2
GM		 4108 attributes.colormap = FRAME_X_COLORMAP (f);
4109 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
4110 | CWColormap);
01f1ba30
JB		 4111
4112 BLOCK_INPUT;
fe24a618 4113 FRAME_X_WINDOW (f)
b9dc4443 4114 = XCreateWindow (FRAME_X_DISPLAY (f),
7556890b
RS		 4115 f->output_data.x->parent_desc,
4116 f->output_data.x->left_pos,
4117 f->output_data.x->top_pos,
f676886a 4118 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
7556890b 4119 f->output_data.x->border_width,
01f1ba30
JB		 4120 CopyFromParent, /* depth */
4121 InputOutput, /* class */
383d6ffc 4122 FRAME_X_VISUAL (f),
01f1ba30 4123 attribute_mask, &attributes);
5a7df7d7
GM		 4124
4125#ifdef HAVE_X_I18N
4bd777b8 4126#ifdef USE_XIM
5a7df7d7
GM		 4127 create_frame_xic (f);
4128 if (FRAME_XIC (f))
4129 {
4130 /* XIM server might require some X events. */
4131 unsigned long fevent = NoEventMask;
4132 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
4133 attributes.event_mask |= fevent;
4134 attribute_mask = CWEventMask;
4135 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4136 attribute_mask, &attributes);
4137 }
4bd777b8 4138#endif
5a7df7d7 4139#endif /* HAVE_X_I18N */
488dd4c4 4140
d387c960 4141 validate_x_resource_name ();
b7975ee4 4142
d5db4077
KR		 4143 class_hints.res_name = (char *) SDATA (Vx_resource_name);
4144 class_hints.res_class = (char *) SDATA (Vx_resource_class);
b9dc4443 4145 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
01f1ba30 4146
00983aba
KH		 4147 /* The menubar is part of the ordinary display;
4148 it does not count in addition to the height of the window. */
7556890b 4149 f->output_data.x->menubar_height = 0;
00983aba 4150
179956b9
JB		 4151 /* This indicates that we use the "Passive Input" input model.
4152 Unless we do this, we don't get the Focus{In,Out} events that we
4153 need to draw the cursor correctly. Accursed bureaucrats.
b9dc4443 4154 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
179956b9 4155
7556890b
RS		 4156 f->output_data.x->wm_hints.input = True;
4157 f->output_data.x->wm_hints.flags |= InputHint;
b9dc4443 4158 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 4159 &f->output_data.x->wm_hints);
6d078211 4160 f->output_data.x->wm_hints.icon_pixmap = None;
179956b9 4161
032e4ebe
RS		 4162 /* Request "save yourself" and "delete window" commands from wm. */
4163 {
4164 Atom protocols[2];
b9dc4443
RS		 4165 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
4166 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
4167 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
032e4ebe 4168 }
9ef48a9d 4169
e373f201
JB		 4170 /* x_set_name normally ignores requests to set the name if the
4171 requested name is the same as the current name. This is the one
4172 place where that assumption isn't correct; f->name is set, but
4173 the X server hasn't been told. */
4174 {
98381190 4175 Lisp_Object name;
cf177271 4176 int explicit = f->explicit_name;
e373f201 4177
cf177271 4178 f->explicit_name = 0;
98381190
KH		 4179 name = f->name;
4180 f->name = Qnil;
cf177271 4181 x_set_name (f, name, explicit);
e373f201
JB		 4182 }
4183
b9dc4443 4184 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 4185 f->output_data.x->text_cursor);
9ef48a9d 4186
01f1ba30
JB		 4187 UNBLOCK_INPUT;
4188
fe24a618 4189 if (FRAME_X_WINDOW (f) == 0)
9ef48a9d 4190 error ("Unable to create window");
01f1ba30
JB		 4191}
4192
488dd4c4 4193#endif /* not USE_GTK */
8fc2766b
RS		 4194#endif /* not USE_X_TOOLKIT */
4195
01f1ba30
JB		 4196/* Handle the icon stuff for this window. Perhaps later we might
4197 want an x_set_icon_position which can be called interactively as
b9dc4443 4198 well. */
01f1ba30
JB		 4199
4200static void
f676886a
JB		 4201x_icon (f, parms)
4202 struct frame *f;
01f1ba30
JB		 4203 Lisp_Object parms;
4204{
f9942c9e 4205 Lisp_Object icon_x, icon_y;
abb4b7ec 4206 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
01f1ba30
JB		 4207
4208 /* Set the position of the icon. Note that twm groups all
b9dc4443 4209 icons in an icon window. */
333b20bb
GM		 4210 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4211 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
f9942c9e 4212 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
01f1ba30 4213 {
b7826503
PJ		 4214 CHECK_NUMBER (icon_x);
4215 CHECK_NUMBER (icon_y);
01f1ba30 4216 }
f9942c9e 4217 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
01f1ba30 4218 error ("Both left and top icon corners of icon must be specified");
01f1ba30 4219
f9942c9e
JB		 4220 BLOCK_INPUT;
4221
fe24a618
JB		 4222 if (! EQ (icon_x, Qunbound))
4223 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
f9942c9e 4224
01f1ba30 4225 /* Start up iconic or window? */
49795535 4226 x_wm_set_window_state
333b20bb
GM		 4227 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
4228 Qicon)
49795535
JB		 4229 ? IconicState
4230 : NormalState));
01f1ba30 4231
d5db4077 4232 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
f468da95 4233 ? f->icon_name
d5db4077 4234 : f->name)));
80534dd6 4235
01f1ba30
JB		 4236 UNBLOCK_INPUT;
4237}
4238
b243755a 4239/* Make the GCs needed for this window, setting the
01f1ba30
JB		 4240 background, border and mouse colors; also create the
4241 mouse cursor and the gray border tile. */
4242
f945b920
JB		 4243static char cursor_bits[] =
4244 {
4245 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4246 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4247 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
4248 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
4249 };
4250
01f1ba30 4251static void
f676886a
JB		 4252x_make_gc (f)
4253 struct frame *f;
01f1ba30
JB		 4254{
4255 XGCValues gc_values;
01f1ba30 4256
6afb1d07
JB		 4257 BLOCK_INPUT;
4258
b243755a 4259 /* Create the GCs of this frame.
9ef48a9d 4260 Note that many default values are used. */
01f1ba30
JB		 4261
4262 /* Normal video */
7556890b
RS		 4263 gc_values.font = f->output_data.x->font->fid;
4264 gc_values.foreground = f->output_data.x->foreground_pixel;
4265 gc_values.background = f->output_data.x->background_pixel;
9ef48a9d 4266 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
959e647d
GM		 4267 f->output_data.x->normal_gc
4268 = XCreateGC (FRAME_X_DISPLAY (f),
4269 FRAME_X_WINDOW (f),
4270 GCLineWidth | GCFont | GCForeground | GCBackground,
4271 &gc_values);
01f1ba30 4272
b9dc4443 4273 /* Reverse video style. */
7556890b
RS		 4274 gc_values.foreground = f->output_data.x->background_pixel;
4275 gc_values.background = f->output_data.x->foreground_pixel;
959e647d
GM		 4276 f->output_data.x->reverse_gc
4277 = XCreateGC (FRAME_X_DISPLAY (f),
4278 FRAME_X_WINDOW (f),
4279 GCFont | GCForeground | GCBackground | GCLineWidth,
4280 &gc_values);
01f1ba30 4281
9ef48a9d 4282 /* Cursor has cursor-color background, background-color foreground. */
7556890b
RS		 4283 gc_values.foreground = f->output_data.x->background_pixel;
4284 gc_values.background = f->output_data.x->cursor_pixel;
01f1ba30
JB		 4285 gc_values.fill_style = FillOpaqueStippled;
4286 gc_values.stipple
b9dc4443
RS		 4287 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
4288 FRAME_X_DISPLAY_INFO (f)->root_window,
01f1ba30 4289 cursor_bits, 16, 16);
7556890b 4290 f->output_data.x->cursor_gc
b9dc4443 4291 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
01f1ba30 4292 (GCFont | GCForeground | GCBackground
ac1f48a4 4293 | GCFillStyle /* | GCStipple */ | GCLineWidth),
01f1ba30
JB		 4294 &gc_values);
4295
333b20bb
GM		 4296 /* Reliefs. */
4297 f->output_data.x->white_relief.gc = 0;
4298 f->output_data.x->black_relief.gc = 0;
4299
01f1ba30 4300 /* Create the gray border tile used when the pointer is not in
f676886a 4301 the frame. Since this depends on the frame's pixel values,
9ef48a9d 4302 this must be done on a per-frame basis. */
7556890b 4303 f->output_data.x->border_tile
d043f1a4 4304 = (XCreatePixmapFromBitmapData
488dd4c4 4305 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
d043f1a4 4306 gray_bits, gray_width, gray_height,
7556890b
RS		 4307 f->output_data.x->foreground_pixel,
4308 f->output_data.x->background_pixel,
ab452f99 4309 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
6afb1d07
JB		 4310
4311 UNBLOCK_INPUT;
01f1ba30 4312}
01f1ba30 4313
959e647d
GM		 4314
4315/* Free what was was allocated in x_make_gc. */
4316
4317void
4318x_free_gcs (f)
4319 struct frame *f;
4320{
4321 Display *dpy = FRAME_X_DISPLAY (f);
4322
4323 BLOCK_INPUT;
488dd4c4 4324
959e647d
GM		 4325 if (f->output_data.x->normal_gc)
4326 {
4327 XFreeGC (dpy, f->output_data.x->normal_gc);
4328 f->output_data.x->normal_gc = 0;
4329 }
4330
4331 if (f->output_data.x->reverse_gc)
4332 {
4333 XFreeGC (dpy, f->output_data.x->reverse_gc);
4334 f->output_data.x->reverse_gc = 0;
4335 }
488dd4c4 4336
959e647d
GM		 4337 if (f->output_data.x->cursor_gc)
4338 {
4339 XFreeGC (dpy, f->output_data.x->cursor_gc);
4340 f->output_data.x->cursor_gc = 0;
4341 }
4342
4343 if (f->output_data.x->border_tile)
4344 {
4345 XFreePixmap (dpy, f->output_data.x->border_tile);
4346 f->output_data.x->border_tile = 0;
4347 }
4348
4349 UNBLOCK_INPUT;
4350}
4351
4352
eaf1eea9
GM		 4353/* Handler for signals raised during x_create_frame and
4354 x_create_top_frame. FRAME is the frame which is partially
4355 constructed. */
4356
4357static Lisp_Object
4358unwind_create_frame (frame)
4359 Lisp_Object frame;
4360{
4361 struct frame *f = XFRAME (frame);
4362
4363 /* If frame is ``official'', nothing to do. */
4364 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4365 {
f1d2ce7f 4366#if GLYPH_DEBUG
eaf1eea9
GM		 4367 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4368#endif
488dd4c4 4369
eaf1eea9
GM		 4370 x_free_frame_resources (f);
4371
4372 /* Check that reference counts are indeed correct. */
4373 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4374 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a 4375 return Qt;
eaf1eea9 4376 }
488dd4c4 4377
eaf1eea9
GM		 4378 return Qnil;
4379}
4380
4381
f676886a 4382DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
01f1ba30 4383 1, 1, 0,
7ee72033 4384 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
c061c855
GM		 4385Returns an Emacs frame object.
4386ALIST is an alist of frame parameters.
4387If the parameters specify that the frame should not have a minibuffer,
4388and do not specify a specific minibuffer window to use,
4389then `default-minibuffer-frame' must be a frame whose minibuffer can
4390be shared by the new frame.
4391
7ee72033
MB		 4392This function is an internal primitive--use `make-frame' instead. */)
4393 (parms)
01f1ba30
JB		 4394 Lisp_Object parms;
4395{
f676886a 4396 struct frame *f;
2365c027 4397 Lisp_Object frame, tem;
01f1ba30
JB		 4398 Lisp_Object name;
4399 int minibuffer_only = 0;
4400 long window_prompting = 0;
4401 int width, height;
331379bf 4402 int count = SPECPDL_INDEX ();
ecaca587 4403 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
b9dc4443 4404 Lisp_Object display;
333b20bb 4405 struct x_display_info *dpyinfo = NULL;
a59e4f3d 4406 Lisp_Object parent;
e557f19d 4407 struct kboard *kb;
01f1ba30 4408
11ae94fe 4409 check_x ();
01f1ba30 4410
b7975ee4
KH		 4411 /* Use this general default value to start with
4412 until we know if this frame has a specified name. */
4413 Vx_resource_name = Vinvocation_name;
4414
333b20bb 4415 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
b9dc4443
RS		 4416 if (EQ (display, Qunbound))
4417 display = Qnil;
4418 dpyinfo = check_x_display_info (display);
e557f19d
KH		 4419#ifdef MULTI_KBOARD
4420 kb = dpyinfo->kboard;
4421#else
4422 kb = &the_only_kboard;
4423#endif
b9dc4443 4424
333b20bb 4425 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
6a5e54e2 4426 if (!STRINGP (name)
cf177271
JB		 4427 && ! EQ (name, Qunbound)
4428 && ! NILP (name))
08a90d6a 4429 error ("Invalid frame name--not a string or nil");
01f1ba30 4430
b7975ee4
KH		 4431 if (STRINGP (name))
4432 Vx_resource_name = name;
4433
a59e4f3d 4434 /* See if parent window is specified. */
333b20bb 4435 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
a59e4f3d
RS		 4436 if (EQ (parent, Qunbound))
4437 parent = Qnil;
4438 if (! NILP (parent))
b7826503 4439 CHECK_NUMBER (parent);
a59e4f3d 4440
ecaca587
RS		 4441 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4442 /* No need to protect DISPLAY because that's not used after passing
4443 it to make_frame_without_minibuffer. */
4444 frame = Qnil;
4445 GCPRO4 (parms, parent, name, frame);
333b20bb
GM		 4446 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
4447 RES_TYPE_SYMBOL);
f9942c9e 4448 if (EQ (tem, Qnone) || NILP (tem))
2526c290 4449 f = make_frame_without_minibuffer (Qnil, kb, display);
f9942c9e 4450 else if (EQ (tem, Qonly))
01f1ba30 4451 {
f676886a 4452 f = make_minibuffer_frame ();
01f1ba30
JB		 4453 minibuffer_only = 1;
4454 }
6a5e54e2 4455 else if (WINDOWP (tem))
2526c290 4456 f = make_frame_without_minibuffer (tem, kb, display);
f9942c9e
JB		 4457 else
4458 f = make_frame (1);
01f1ba30 4459
ecaca587
RS		 4460 XSETFRAME (frame, f);
4461
a3c87d4e
JB		 4462 /* Note that X Windows does support scroll bars. */
4463 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
179956b9 4464
08a90d6a 4465 f->output_method = output_x_window;
7556890b
RS		 4466 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
4467 bzero (f->output_data.x, sizeof (struct x_output));
4468 f->output_data.x->icon_bitmap = -1;
0ecca023 4469 f->output_data.x->fontset = -1;
333b20bb
GM		 4470 f->output_data.x->scroll_bar_foreground_pixel = -1;
4471 f->output_data.x->scroll_bar_background_pixel = -1;
f15340b7
MB		 4472#ifdef USE_TOOLKIT_SCROLL_BARS
4473 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
4474 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
4475#endif /* USE_TOOLKIT_SCROLL_BARS */
eaf1eea9 4476 record_unwind_protect (unwind_create_frame, frame);
08a90d6a 4477
f468da95 4478 f->icon_name
333b20bb
GM		 4479 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
4480 RES_TYPE_STRING);
f468da95
RS		 4481 if (! STRINGP (f->icon_name))
4482 f->icon_name = Qnil;
80534dd6 4483
08a90d6a 4484 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 4485#if GLYPH_DEBUG
eaf1eea9
GM		 4486 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
4487 dpyinfo_refcount = dpyinfo->reference_count;
4488#endif /* GLYPH_DEBUG */
73410c76 4489#ifdef MULTI_KBOARD
e557f19d 4490 FRAME_KBOARD (f) = kb;
73410c76 4491#endif
08a90d6a 4492
9b2956e2
GM		 4493 /* These colors will be set anyway later, but it's important
4494 to get the color reference counts right, so initialize them! */
4495 {
4496 Lisp_Object black;
4497 struct gcpro gcpro1;
cefecbcf
GM		 4498
4499 /* Function x_decode_color can signal an error. Make
4500 sure to initialize color slots so that we won't try
4501 to free colors we haven't allocated. */
4502 f->output_data.x->foreground_pixel = -1;
4503 f->output_data.x->background_pixel = -1;
4504 f->output_data.x->cursor_pixel = -1;
4505 f->output_data.x->cursor_foreground_pixel = -1;
4506 f->output_data.x->border_pixel = -1;
4507 f->output_data.x->mouse_pixel = -1;
488dd4c4 4508
9b2956e2
GM		 4509 black = build_string ("black");
4510 GCPRO1 (black);
4511 f->output_data.x->foreground_pixel
4512 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4513 f->output_data.x->background_pixel
4514 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4515 f->output_data.x->cursor_pixel
4516 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4517 f->output_data.x->cursor_foreground_pixel
4518 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4519 f->output_data.x->border_pixel
4520 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4521 f->output_data.x->mouse_pixel
4522 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4523 UNGCPRO;
4524 }
4525
a59e4f3d
RS		 4526 /* Specify the parent under which to make this X window. */
4527
4528 if (!NILP (parent))
4529 {
8c239ac3 4530 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
7556890b 4531 f->output_data.x->explicit_parent = 1;
a59e4f3d
RS		 4532 }
4533 else
4534 {
7556890b
RS		 4535 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4536 f->output_data.x->explicit_parent = 0;
a59e4f3d
RS		 4537 }
4538
cf177271
JB		 4539 /* Set the name; the functions to which we pass f expect the name to
4540 be set. */
4541 if (EQ (name, Qunbound) || NILP (name))
4542 {
08a90d6a 4543 f->name = build_string (dpyinfo->x_id_name);
cf177271
JB		 4544 f->explicit_name = 0;
4545 }
4546 else
4547 {
4548 f->name = name;
4549 f->explicit_name = 1;
9ef48a9d
RS		 4550 /* use the frame's title when getting resources for this frame. */
4551 specbind (Qx_resource_name, name);
cf177271 4552 }
01f1ba30 4553
01f1ba30
JB		 4554 /* Extract the window parameters from the supplied values
4555 that are needed to determine window geometry. */
d387c960
JB		 4556 {
4557 Lisp_Object font;
4558
333b20bb 4559 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
2ee3abaa 4560
6817eab4 4561 BLOCK_INPUT;
e5e548e3
RS		 4562 /* First, try whatever font the caller has specified. */
4563 if (STRINGP (font))
942ea06d 4564 {
49965a29 4565 tem = Fquery_fontset (font, Qnil);
477f8642 4566 if (STRINGP (tem))
d5db4077 4567 font = x_new_fontset (f, SDATA (tem));
942ea06d 4568 else
d5db4077 4569 font = x_new_font (f, SDATA (font));
942ea06d 4570 }
488dd4c4 4571
e5e548e3 4572 /* Try out a font which we hope has bold and italic variations. */
333b20bb
GM		 4573 if (!STRINGP (font))
4574 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
e5e548e3 4575 if (!STRINGP (font))
a6ac02af 4576 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
e5e548e3 4577 if (! STRINGP (font))
a6ac02af 4578 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
e5e548e3
RS		 4579 if (! STRINGP (font))
4580 /* This was formerly the first thing tried, but it finds too many fonts
4581 and takes too long. */
4582 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4583 /* If those didn't work, look for something which will at least work. */
4584 if (! STRINGP (font))
a6ac02af 4585 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
6817eab4
JB		 4586 UNBLOCK_INPUT;
4587 if (! STRINGP (font))
e5e548e3
RS		 4588 font = build_string ("fixed");
4589
477f8642 4590 x_default_parameter (f, parms, Qfont, font,
333b20bb 4591 "font", "Font", RES_TYPE_STRING);
d387c960 4592 }
9ef48a9d 4593
e3881aa0 4594#ifdef USE_LUCID
82c90203
RS		 4595 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4596 whereby it fails to get any font. */
7556890b 4597 xlwmenu_default_font = f->output_data.x->font;
dd254b21 4598#endif
82c90203 4599
cf177271 4600 x_default_parameter (f, parms, Qborder_width, make_number (2),
333b20bb 4601 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
488dd4c4 4602
4e397688 4603 /* This defaults to 1 in order to match xterm. We recognize either
ddf768c3
JB		 4604 internalBorderWidth or internalBorder (which is what xterm calls
4605 it). */
4606 if (NILP (Fassq (Qinternal_border_width, parms)))
4607 {
4608 Lisp_Object value;
4609
abb4b7ec 4610 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
333b20bb 4611 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
ddf768c3
JB		 4612 if (! EQ (value, Qunbound))
4613 parms = Fcons (Fcons (Qinternal_border_width, value),
4614 parms);
4615 }
dca97592 4616 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
333b20bb
GM		 4617 "internalBorderWidth", "internalBorderWidth",
4618 RES_TYPE_NUMBER);
1ab3d87e 4619 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
333b20bb
GM		 4620 "verticalScrollBars", "ScrollBars",
4621 RES_TYPE_SYMBOL);
01f1ba30 4622
b9dc4443 4623 /* Also do the stuff which must be set before the window exists. */
cf177271 4624 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
333b20bb 4625 "foreground", "Foreground", RES_TYPE_STRING);
cf177271 4626 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
0b60fc91 4627 "background", "Background", RES_TYPE_STRING);
cf177271 4628 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
333b20bb 4629 "pointerColor", "Foreground", RES_TYPE_STRING);
cf177271 4630 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
333b20bb 4631 "cursorColor", "Foreground", RES_TYPE_STRING);
cf177271 4632 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
333b20bb 4633 "borderColor", "BorderColor", RES_TYPE_STRING);
d62c8769
GM		 4634 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
4635 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
563b67aa
GM		 4636 x_default_parameter (f, parms, Qline_spacing, Qnil,
4637 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
b3ba0aa8
KS		 4638 x_default_parameter (f, parms, Qleft_fringe, Qnil,
4639 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4640 x_default_parameter (f, parms, Qright_fringe, Qnil,
4641 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
333b20bb
GM		 4642
4643 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
4644 "scrollBarForeground",
4645 "ScrollBarForeground", 1);
4646 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
4647 "scrollBarBackground",
4648 "ScrollBarBackground", 0);
4649
4650 /* Init faces before x_default_parameter is called for scroll-bar
4651 parameters because that function calls x_set_scroll_bar_width,
4652 which calls change_frame_size, which calls Fset_window_buffer,
4653 which runs hooks, which call Fvertical_motion. At the end, we
4654 end up in init_iterator with a null face cache, which should not
4655 happen. */
4656 init_frame_faces (f);
488dd4c4 4657
c7bcb20d 4658 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
333b20bb 4659 "menuBar", "MenuBar", RES_TYPE_NUMBER);
e33455ca 4660 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
333b20bb 4661 "toolBar", "ToolBar", RES_TYPE_NUMBER);
79873d50 4662 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
333b20bb
GM		 4663 "bufferPredicate", "BufferPredicate",
4664 RES_TYPE_SYMBOL);
c2304e02 4665 x_default_parameter (f, parms, Qtitle, Qnil,
333b20bb 4666 "title", "Title", RES_TYPE_STRING);
ea0a1f53
GM		 4667 x_default_parameter (f, parms, Qwait_for_wm, Qt,
4668 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
49d41073
EZ		 4669 x_default_parameter (f, parms, Qfullscreen, Qnil,
4670 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
90eb1019 4671
7556890b 4672 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
35f59f6b
GM		 4673
4674 /* Add the tool-bar height to the initial frame height so that the
4675 user gets a text display area of the size he specified with -g or
4676 via .Xdefaults. Later changes of the tool-bar height don't
4677 change the frame size. This is done so that users can create
4678 tall Emacs frames without having to guess how tall the tool-bar
4679 will get. */
4680 if (FRAME_TOOL_BAR_LINES (f))
4681 {
4682 int margin, relief, bar_height;
488dd4c4 4683
8ed86491 4684 relief = (tool_bar_button_relief >= 0
35f59f6b
GM		 4685 ? tool_bar_button_relief
4686 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4687
4688 if (INTEGERP (Vtool_bar_button_margin)
4689 && XINT (Vtool_bar_button_margin) > 0)
4690 margin = XFASTINT (Vtool_bar_button_margin);
4691 else if (CONSP (Vtool_bar_button_margin)
4692 && INTEGERP (XCDR (Vtool_bar_button_margin))
4693 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4694 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4695 else
4696 margin = 0;
488dd4c4 4697
35f59f6b
GM		 4698 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4699 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
4700 }
4701
4702 /* Compute the size of the X window. */
f676886a 4703 window_prompting = x_figure_window_size (f, parms);
01f1ba30 4704
f83f10ba 4705 if (window_prompting & XNegative)
2365c027 4706 {
f83f10ba 4707 if (window_prompting & YNegative)
7556890b 4708 f->output_data.x->win_gravity = SouthEastGravity;
f83f10ba 4709 else
7556890b 4710 f->output_data.x->win_gravity = NorthEastGravity;
f83f10ba
RS		 4711 }
4712 else
4713 {
4714 if (window_prompting & YNegative)
7556890b 4715 f->output_data.x->win_gravity = SouthWestGravity;
f83f10ba 4716 else
7556890b 4717 f->output_data.x->win_gravity = NorthWestGravity;
2365c027
RS		 4718 }
4719
7556890b 4720 f->output_data.x->size_hint_flags = window_prompting;
38d22040 4721
495fa05e
GM		 4722 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4723 f->no_split = minibuffer_only || EQ (tem, Qt);
4724
6a1bcd01 4725 /* Create the X widget or window. */
a7f7d550
FP		 4726#ifdef USE_X_TOOLKIT
4727 x_window (f, window_prompting, minibuffer_only);
4728#else
f676886a 4729 x_window (f);
a7f7d550 4730#endif
488dd4c4 4731
f676886a
JB		 4732 x_icon (f, parms);
4733 x_make_gc (f);
01f1ba30 4734
495fa05e
GM		 4735 /* Now consider the frame official. */
4736 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4737 Vframe_list = Fcons (frame, Vframe_list);
4738
f9942c9e
JB		 4739 /* We need to do this after creating the X window, so that the
4740 icon-creation functions can say whose icon they're describing. */
cf177271 4741 x_default_parameter (f, parms, Qicon_type, Qnil,
333b20bb 4742 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
f9942c9e 4743
cf177271 4744 x_default_parameter (f, parms, Qauto_raise, Qnil,
333b20bb 4745 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
cf177271 4746 x_default_parameter (f, parms, Qauto_lower, Qnil,
333b20bb 4747 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
dbc4e1c1 4748 x_default_parameter (f, parms, Qcursor_type, Qbox,
333b20bb 4749 "cursorType", "CursorType", RES_TYPE_SYMBOL);
28d7281d
GM		 4750 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4751 "scrollBarWidth", "ScrollBarWidth",
4752 RES_TYPE_NUMBER);
f9942c9e 4753
f676886a 4754 /* Dimensions, especially f->height, must be done via change_frame_size.
01f1ba30 4755 Change will not be effected unless different from the current
b9dc4443 4756 f->height. */
f676886a
JB		 4757 width = f->width;
4758 height = f->height;
488dd4c4 4759
1ab3d87e
RS		 4760 f->height = 0;
4761 SET_FRAME_WIDTH (f, 0);
8938a4fb 4762 change_frame_size (f, height, width, 1, 0, 0);
d043f1a4 4763
4a967a9b
GM		 4764 /* Set up faces after all frame parameters are known. This call
4765 also merges in face attributes specified for new frames. If we
4766 don't do this, the `menu' face for instance won't have the right
4767 colors, and the menu bar won't appear in the specified colors for
4768 new frames. */
4769 call1 (Qface_set_after_frame_default, frame);
4770
488dd4c4 4771#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
495fa05e
GM		 4772 /* Create the menu bar. */
4773 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4774 {
4775 /* If this signals an error, we haven't set size hints for the
4776 frame and we didn't make it visible. */
4777 initialize_frame_menubar (f);
4778
488dd4c4 4779#ifndef USE_GTK
495fa05e
GM		 4780 /* This is a no-op, except under Motif where it arranges the
4781 main window for the widgets on it. */
4782 lw_set_main_areas (f->output_data.x->column_widget,
4783 f->output_data.x->menubar_widget,
4784 f->output_data.x->edit_widget);
488dd4c4 4785#endif /* not USE_GTK */
495fa05e 4786 }
488dd4c4 4787#endif /* USE_X_TOOLKIT || USE_GTK */
495fa05e
GM		 4788
4789 /* Tell the server what size and position, etc, we want, and how
4790 badly we want them. This should be done after we have the menu
4791 bar so that its size can be taken into account. */
01f1ba30 4792 BLOCK_INPUT;
7989f084 4793 x_wm_set_size_hint (f, window_prompting, 0);
01f1ba30
JB		 4794 UNBLOCK_INPUT;
4795
495fa05e
GM		 4796 /* Make the window appear on the frame and enable display, unless
4797 the caller says not to. However, with explicit parent, Emacs
4798 cannot control visibility, so don't try. */
7556890b 4799 if (! f->output_data.x->explicit_parent)
a59e4f3d
RS		 4800 {
4801 Lisp_Object visibility;
49795535 4802
333b20bb
GM		 4803 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
4804 RES_TYPE_SYMBOL);
a59e4f3d
RS		 4805 if (EQ (visibility, Qunbound))
4806 visibility = Qt;
49795535 4807
a59e4f3d
RS		 4808 if (EQ (visibility, Qicon))
4809 x_iconify_frame (f);
4810 else if (! NILP (visibility))
4811 x_make_frame_visible (f);
4812 else
4813 /* Must have been Qnil. */
4814 ;
4815 }
01f1ba30 4816
495fa05e 4817 UNGCPRO;
9e57df62
GM		 4818
4819 /* Make sure windows on this frame appear in calls to next-window
4820 and similar functions. */
4821 Vwindow_list = Qnil;
488dd4c4 4822
9ef48a9d 4823 return unbind_to (count, frame);
01f1ba30
JB		 4824}
4825
eaf1eea9 4826
0d17d282
KH		 4827/* FRAME is used only to get a handle on the X display. We don't pass the
4828 display info directly because we're called from frame.c, which doesn't
4829 know about that structure. */
e4f79258 4830
87498171 4831Lisp_Object
0d17d282
KH		 4832x_get_focus_frame (frame)
4833 struct frame *frame;
87498171 4834{
0d17d282 4835 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
87498171 4836 Lisp_Object xfocus;
0d17d282 4837 if (! dpyinfo->x_focus_frame)
87498171
KH		 4838 return Qnil;
4839
0d17d282 4840 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
87498171
KH		 4841 return xfocus;
4842}
f0614854 4843
3decc1e7
GM		 4844
4845/* In certain situations, when the window manager follows a
4846 click-to-focus policy, there seems to be no way around calling
4847 XSetInputFocus to give another frame the input focus .
4848
4849 In an ideal world, XSetInputFocus should generally be avoided so
4850 that applications don't interfere with the window manager's focus
4851 policy. But I think it's okay to use when it's clearly done
4852 following a user-command. */
4853
4854DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
7ee72033
MB		 4855 doc: /* Set the input focus to FRAME.
4856FRAME nil means use the selected frame. */)
4857 (frame)
3decc1e7
GM		 4858 Lisp_Object frame;
4859{
4860 struct frame *f = check_x_frame (frame);
4861 Display *dpy = FRAME_X_DISPLAY (f);
4862 int count;
4863
4864 BLOCK_INPUT;
4865 count = x_catch_errors (dpy);
4866 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4867 RevertToParent, CurrentTime);
4868 x_uncatch_errors (dpy, count);
4869 UNBLOCK_INPUT;
488dd4c4 4870
3decc1e7
GM		 4871 return Qnil;
4872}
4873
f0614854 4874\f
2d764c78 4875DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
7ee72033
MB		 4876 doc: /* Internal function called by `color-defined-p', which see. */)
4877 (color, frame)
b9dc4443 4878 Lisp_Object color, frame;
e12d55b2 4879{
b9dc4443
RS		 4880 XColor foo;
4881 FRAME_PTR f = check_x_frame (frame);
e12d55b2 4882
b7826503 4883 CHECK_STRING (color);
b9dc4443 4884
d5db4077 4885 if (x_defined_color (f, SDATA (color), &foo, 0))
e12d55b2
RS		 4886 return Qt;
4887 else
4888 return Qnil;
4889}
4890
2d764c78 4891DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
7ee72033
MB		 4892 doc: /* Internal function called by `color-values', which see. */)
4893 (color, frame)
b9dc4443 4894 Lisp_Object color, frame;
01f1ba30 4895{
b9dc4443
RS		 4896 XColor foo;
4897 FRAME_PTR f = check_x_frame (frame);
4898
b7826503 4899 CHECK_STRING (color);
01f1ba30 4900
d5db4077 4901 if (x_defined_color (f, SDATA (color), &foo, 0))
57c82a63
RS		 4902 {
4903 Lisp_Object rgb[3];
4904
4905 rgb[0] = make_number (foo.red);
4906 rgb[1] = make_number (foo.green);
4907 rgb[2] = make_number (foo.blue);
4908 return Flist (3, rgb);
4909 }
01f1ba30
JB		 4910 else
4911 return Qnil;
4912}
4913
2d764c78 4914DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
7ee72033
MB		 4915 doc: /* Internal function called by `display-color-p', which see. */)
4916 (display)
08a90d6a 4917 Lisp_Object display;
01f1ba30 4918{
08a90d6a 4919 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 4920
b9dc4443 4921 if (dpyinfo->n_planes <= 2)
01f1ba30
JB		 4922 return Qnil;
4923
b9dc4443 4924 switch (dpyinfo->visual->class)
01f1ba30
JB		 4925 {
4926 case StaticColor:
4927 case PseudoColor:
4928 case TrueColor:
4929 case DirectColor:
4930 return Qt;
4931
4932 default:
4933 return Qnil;
4934 }
4935}
4936
d0c9d219 4937DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
c061c855 4938 0, 1, 0,
7ee72033 4939 doc: /* Return t if the X display supports shades of gray.
c061c855
GM		 4940Note that color displays do support shades of gray.
4941The optional argument DISPLAY specifies which display to ask about.
4942DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4943If omitted or nil, that stands for the selected frame's display. */)
4944 (display)
08a90d6a 4945 Lisp_Object display;
d0c9d219 4946{
08a90d6a 4947 struct x_display_info *dpyinfo = check_x_display_info (display);
d0c9d219 4948
ae6b58f9 4949 if (dpyinfo->n_planes <= 1)
b9dc4443
RS		 4950 return Qnil;
4951
ae6b58f9
RS		 4952 switch (dpyinfo->visual->class)
4953 {
4954 case StaticColor:
4955 case PseudoColor:
4956 case TrueColor:
4957 case DirectColor:
4958 case StaticGray:
4959 case GrayScale:
4960 return Qt;
4961
4962 default:
4963 return Qnil;
4964 }
d0c9d219
RS		 4965}
4966
41beb8fc 4967DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
c061c855 4968 0, 1, 0,
7ee72033 4969 doc: /* Returns the width in pixels 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 (dpyinfo->width);
41beb8fc
RS		 4979}
4980
4981DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
c061c855 4982 Sx_display_pixel_height, 0, 1, 0,
7ee72033 4983 doc: /* Returns the height in pixels of the X display DISPLAY.
c061c855
GM		 4984The optional argument DISPLAY specifies which display to ask about.
4985DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 4986If omitted or nil, that stands for the selected frame's display. */)
4987 (display)
08a90d6a 4988 Lisp_Object display;
41beb8fc 4989{
08a90d6a 4990 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 4991
4992 return make_number (dpyinfo->height);
41beb8fc
RS		 4993}
4994
4995DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
c061c855 4996 0, 1, 0,
7ee72033 4997 doc: /* Returns the number of bitplanes of the X display DISPLAY.
c061c855
GM		 4998The optional argument DISPLAY specifies which display to ask about.
4999DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5000If omitted or nil, that stands for the selected frame's display. */)
5001 (display)
08a90d6a 5002 Lisp_Object display;
41beb8fc 5003{
08a90d6a 5004 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5005
5006 return make_number (dpyinfo->n_planes);
41beb8fc
RS		 5007}
5008
5009DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
c061c855 5010 0, 1, 0,
7ee72033 5011 doc: /* Returns the number of color cells of the X display DISPLAY.
c061c855
GM		 5012The optional argument DISPLAY specifies which display to ask about.
5013DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5014If omitted or nil, that stands for the selected frame's display. */)
5015 (display)
08a90d6a 5016 Lisp_Object display;
41beb8fc 5017{
08a90d6a 5018 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5019
5020 return make_number (DisplayCells (dpyinfo->display,
5021 XScreenNumberOfScreen (dpyinfo->screen)));
41beb8fc
RS		 5022}
5023
9d317b2c
RS		 5024DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5025 Sx_server_max_request_size,
c061c855 5026 0, 1, 0,
7ee72033 5027 doc: /* Returns the maximum request size of the X server of display DISPLAY.
c061c855
GM		 5028The optional argument DISPLAY specifies which display to ask about.
5029DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5030If omitted or nil, that stands for the selected frame's display. */)
5031 (display)
08a90d6a 5032 Lisp_Object display;
9d317b2c 5033{
08a90d6a 5034 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5035
5036 return make_number (MAXREQUEST (dpyinfo->display));
9d317b2c
RS		 5037}
5038
41beb8fc 5039DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
7ee72033 5040 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
c061c855
GM		 5041The optional argument DISPLAY specifies which display to ask about.
5042DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5043If omitted or nil, that stands for the selected frame's display. */)
5044 (display)
08a90d6a 5045 Lisp_Object display;
41beb8fc 5046{
08a90d6a 5047 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5048 char *vendor = ServerVendor (dpyinfo->display);
5049
41beb8fc
RS		 5050 if (! vendor) vendor = "";
5051 return build_string (vendor);
5052}
5053
5054DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
7ee72033 5055 doc: /* Returns the version numbers of the X server of display DISPLAY.
c061c855
GM		 5056The value is a list of three integers: the major and minor
5057version numbers of the X Protocol in use, and the vendor-specific release
5058number. See also the function `x-server-vendor'.
5059
5060The optional argument DISPLAY specifies which display to ask about.
5061DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5062If omitted or nil, that stands for the selected frame's display. */)
5063 (display)
08a90d6a 5064 Lisp_Object display;
41beb8fc 5065{
08a90d6a 5066 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443 5067 Display *dpy = dpyinfo->display;
11ae94fe 5068
41beb8fc
RS		 5069 return Fcons (make_number (ProtocolVersion (dpy)),
5070 Fcons (make_number (ProtocolRevision (dpy)),
5071 Fcons (make_number (VendorRelease (dpy)), Qnil)));
5072}
5073
5074DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
7ee72033 5075 doc: /* Return the number of screens on the X server of display DISPLAY.
c061c855
GM		 5076The optional argument DISPLAY specifies which display to ask about.
5077DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5078If omitted or nil, that stands for the selected frame's display. */)
5079 (display)
08a90d6a 5080 Lisp_Object display;
41beb8fc 5081{
08a90d6a 5082 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5083
5084 return make_number (ScreenCount (dpyinfo->display));
41beb8fc
RS		 5085}
5086
5087DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
7ee72033 5088 doc: /* Return the height in millimeters of the X display DISPLAY.
c061c855
GM		 5089The optional argument DISPLAY specifies which display to ask about.
5090DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5091If omitted or nil, that stands for the selected frame's display. */)
5092 (display)
08a90d6a 5093 Lisp_Object display;
41beb8fc 5094{
08a90d6a 5095 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5096
5097 return make_number (HeightMMOfScreen (dpyinfo->screen));
41beb8fc
RS		 5098}
5099
5100DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
7ee72033 5101 doc: /* Return the width in millimeters of the X display DISPLAY.
c061c855
GM		 5102The optional argument DISPLAY specifies which display to ask about.
5103DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5104If omitted or nil, that stands for the selected frame's display. */)
5105 (display)
08a90d6a 5106 Lisp_Object display;
41beb8fc 5107{
08a90d6a 5108 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS		 5109
5110 return make_number (WidthMMOfScreen (dpyinfo->screen));
41beb8fc
RS		 5111}
5112
5113DEFUN ("x-display-backing-store", Fx_display_backing_store,
c061c855 5114 Sx_display_backing_store, 0, 1, 0,
7ee72033 5115 doc: /* Returns an indication of whether X display DISPLAY does backing store.
c061c855
GM		 5116The value may be `always', `when-mapped', or `not-useful'.
5117The optional argument DISPLAY specifies which display to ask about.
5118DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5119If omitted or nil, that stands for the selected frame's display. */)
5120 (display)
08a90d6a 5121 Lisp_Object display;
41beb8fc 5122{
08a90d6a 5123 struct x_display_info *dpyinfo = check_x_display_info (display);
8ec8a5ec 5124 Lisp_Object result;
11ae94fe 5125
b9dc4443 5126 switch (DoesBackingStore (dpyinfo->screen))
41beb8fc
RS		 5127 {
5128 case Always:
8ec8a5ec
GM		 5129 result = intern ("always");
5130 break;
41beb8fc
RS		 5131
5132 case WhenMapped:
8ec8a5ec
GM		 5133 result = intern ("when-mapped");
5134 break;
41beb8fc
RS		 5135
5136 case NotUseful:
8ec8a5ec
GM		 5137 result = intern ("not-useful");
5138 break;
41beb8fc
RS		 5139
5140 default:
5141 error ("Strange value for BackingStore parameter of screen");
8ec8a5ec 5142 result = Qnil;
41beb8fc 5143 }
8ec8a5ec
GM		 5144
5145 return result;
41beb8fc
RS		 5146}
5147
5148DEFUN ("x-display-visual-class", Fx_display_visual_class,
c061c855 5149 Sx_display_visual_class, 0, 1, 0,
7ee72033 5150 doc: /* Return the visual class of the X display DISPLAY.
c061c855
GM		 5151The value is one of the symbols `static-gray', `gray-scale',
5152`static-color', `pseudo-color', `true-color', or `direct-color'.
5153
5154The optional argument DISPLAY specifies which display to ask about.
5155DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5156If omitted or nil, that stands for the selected frame's display. */)
5157 (display)
08a90d6a 5158 Lisp_Object display;
41beb8fc 5159{
08a90d6a 5160 struct x_display_info *dpyinfo = check_x_display_info (display);
8ec8a5ec 5161 Lisp_Object result;
11ae94fe 5162
b9dc4443 5163 switch (dpyinfo->visual->class)
41beb8fc 5164 {
8ec8a5ec
GM		 5165 case StaticGray:
5166 result = intern ("static-gray");
5167 break;
5168 case GrayScale:
5169 result = intern ("gray-scale");
5170 break;
5171 case StaticColor:
5172 result = intern ("static-color");
5173 break;
5174 case PseudoColor:
5175 result = intern ("pseudo-color");
5176 break;
5177 case TrueColor:
5178 result = intern ("true-color");
5179 break;
5180 case DirectColor:
5181 result = intern ("direct-color");
5182 break;
41beb8fc
RS		 5183 default:
5184 error ("Display has an unknown visual class");
8ec8a5ec 5185 result = Qnil;
41beb8fc 5186 }
488dd4c4 5187
8ec8a5ec 5188 return result;
41beb8fc
RS		 5189}
5190
5191DEFUN ("x-display-save-under", Fx_display_save_under,
c061c855 5192 Sx_display_save_under, 0, 1, 0,
7ee72033 5193 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
c061c855
GM		 5194The optional argument DISPLAY specifies which display to ask about.
5195DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5196If omitted or nil, that stands for the selected frame's display. */)
5197 (display)
08a90d6a 5198 Lisp_Object display;
41beb8fc 5199{
08a90d6a 5200 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 5201
b9dc4443 5202 if (DoesSaveUnders (dpyinfo->screen) == True)
41beb8fc
RS		 5203 return Qt;
5204 else
5205 return Qnil;
5206}
5207\f
b9dc4443 5208int
55caf99c
RS		 5209x_pixel_width (f)
5210 register struct frame *f;
01f1ba30 5211{
55caf99c 5212 return PIXEL_WIDTH (f);
01f1ba30
JB		 5213}
5214
b9dc4443 5215int
55caf99c
RS		 5216x_pixel_height (f)
5217 register struct frame *f;
01f1ba30 5218{
55caf99c
RS		 5219 return PIXEL_HEIGHT (f);
5220}
5221
b9dc4443 5222int
55caf99c
RS		 5223x_char_width (f)
5224 register struct frame *f;
5225{
7556890b 5226 return FONT_WIDTH (f->output_data.x->font);
55caf99c
RS		 5227}
5228
b9dc4443 5229int
55caf99c
RS		 5230x_char_height (f)
5231 register struct frame *f;
5232{
7556890b 5233 return f->output_data.x->line_height;
01f1ba30 5234}
b9dc4443
RS		 5235
5236int
f03f2489
RS		 5237x_screen_planes (f)
5238 register struct frame *f;
b9dc4443 5239{
f03f2489 5240 return FRAME_X_DISPLAY_INFO (f)->n_planes;
b9dc4443 5241}
01f1ba30 5242
a6ad00c0
GM		 5243
5244\f
5245/************************************************************************
5246 X Displays
5247 ************************************************************************/
5248
01f1ba30 5249\f
a6ad00c0
GM		 5250/* Mapping visual names to visuals. */
5251
5252static struct visual_class
5253{
5254 char *name;
5255 int class;
5256}
5257visual_classes[] =
5258{
5259 {"StaticGray", StaticGray},
5260 {"GrayScale", GrayScale},
5261 {"StaticColor", StaticColor},
5262 {"PseudoColor", PseudoColor},
5263 {"TrueColor", TrueColor},
5264 {"DirectColor", DirectColor},
9908a324 5265 {NULL, 0}
a6ad00c0
GM		 5266};
5267
5268
404daac1 5269#ifndef HAVE_XSCREENNUMBEROFSCREEN
a6ad00c0
GM		 5270
5271/* Value is the screen number of screen SCR. This is a substitute for
5272 the X function with the same name when that doesn't exist. */
5273
404daac1
RS		 5274int
5275XScreenNumberOfScreen (scr)
5276 register Screen *scr;
5277{
a6ad00c0
GM		 5278 Display *dpy = scr->display;
5279 int i;
3df34fdb 5280
a6ad00c0 5281 for (i = 0; i < dpy->nscreens; ++i)
fbd5ceb2 5282 if (scr == dpy->screens + i)
a6ad00c0 5283 break;
404daac1 5284
a6ad00c0 5285 return i;
404daac1 5286}
a6ad00c0 5287
404daac1
RS		 5288#endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5289
01f1ba30 5290
a6ad00c0
GM		 5291/* Select the visual that should be used on display DPYINFO. Set
5292 members of DPYINFO appropriately. Called from x_term_init. */
fe24a618 5293
a6ad00c0
GM		 5294void
5295select_visual (dpyinfo)
5296 struct x_display_info *dpyinfo;
5297{
5298 Display *dpy = dpyinfo->display;
5299 Screen *screen = dpyinfo->screen;
5300 Lisp_Object value;
fe24a618 5301
a6ad00c0
GM		 5302 /* See if a visual is specified. */
5303 value = display_x_get_resource (dpyinfo,
5304 build_string ("visualClass"),
5305 build_string ("VisualClass"),
5306 Qnil, Qnil);
5307 if (STRINGP (value))
5308 {
5309 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
5310 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
5311 depth, a decimal number. NAME is compared with case ignored. */
d5db4077 5312 char *s = (char *) alloca (SBYTES (value) + 1);
a6ad00c0
GM		 5313 char *dash;
5314 int i, class = -1;
5315 XVisualInfo vinfo;
5316
d5db4077 5317 strcpy (s, SDATA (value));
a6ad00c0
GM		 5318 dash = index (s, '-');
5319 if (dash)
5320 {
5321 dpyinfo->n_planes = atoi (dash + 1);
5322 *dash = '\0';
5323 }
5324 else
5325 /* We won't find a matching visual with depth 0, so that
5326 an error will be printed below. */
5327 dpyinfo->n_planes = 0;
f0614854 5328
a6ad00c0
GM		 5329 /* Determine the visual class. */
5330 for (i = 0; visual_classes[i].name; ++i)
5331 if (xstricmp (s, visual_classes[i].name) == 0)
5332 {
5333 class = visual_classes[i].class;
5334 break;
5335 }
01f1ba30 5336
a6ad00c0
GM		 5337 /* Look up a matching visual for the specified class. */
5338 if (class == -1
5339 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
5340 dpyinfo->n_planes, class, &vinfo))
d5db4077 5341 fatal ("Invalid visual specification `%s'", SDATA (value));
488dd4c4 5342
a6ad00c0
GM		 5343 dpyinfo->visual = vinfo.visual;
5344 }
01f1ba30
JB		 5345 else
5346 {
a6ad00c0
GM		 5347 int n_visuals;
5348 XVisualInfo *vinfo, vinfo_template;
488dd4c4 5349
a6ad00c0
GM		 5350 dpyinfo->visual = DefaultVisualOfScreen (screen);
5351
5352#ifdef HAVE_X11R4
5353 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
5354#else
5355 vinfo_template.visualid = dpyinfo->visual->visualid;
5356#endif
5357 vinfo_template.screen = XScreenNumberOfScreen (screen);
5358 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
5359 &vinfo_template, &n_visuals);
5360 if (n_visuals != 1)
5361 fatal ("Can't get proper X visual info");
5362
94ac875b 5363 dpyinfo->n_planes = vinfo->depth;
a6ad00c0
GM		 5364 XFree ((char *) vinfo);
5365 }
01f1ba30 5366}
01f1ba30 5367
a6ad00c0 5368
b9dc4443
RS		 5369/* Return the X display structure for the display named NAME.
5370 Open a new connection if necessary. */
5371
5372struct x_display_info *
5373x_display_info_for_name (name)
5374 Lisp_Object name;
5375{
08a90d6a 5376 Lisp_Object names;
b9dc4443
RS		 5377 struct x_display_info *dpyinfo;
5378
b7826503 5379 CHECK_STRING (name);
b9dc4443 5380
806048df
RS		 5381 if (! EQ (Vwindow_system, intern ("x")))
5382 error ("Not using X Windows");
5383
08a90d6a
RS		 5384 for (dpyinfo = x_display_list, names = x_display_name_list;
5385 dpyinfo;
8e713be6 5386 dpyinfo = dpyinfo->next, names = XCDR (names))
b9dc4443
RS		 5387 {
5388 Lisp_Object tem;
8e713be6 5389 tem = Fstring_equal (XCAR (XCAR (names)), name);
08a90d6a 5390 if (!NILP (tem))
b9dc4443
RS		 5391 return dpyinfo;
5392 }
5393
b7975ee4
KH		 5394 /* Use this general default value to start with. */
5395 Vx_resource_name = Vinvocation_name;
5396
b9dc4443
RS		 5397 validate_x_resource_name ();
5398
9b207e8e 5399 dpyinfo = x_term_init (name, (char *)0,
d5db4077 5400 (char *) SDATA (Vx_resource_name));
b9dc4443 5401
08a90d6a 5402 if (dpyinfo == 0)
d5db4077 5403 error ("Cannot connect to X server %s", SDATA (name));
08a90d6a 5404
b9dc4443
RS		 5405 x_in_use = 1;
5406 XSETFASTINT (Vwindow_system_version, 11);
5407
5408 return dpyinfo;
5409}
5410
a6ad00c0 5411
01f1ba30 5412DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
c061c855 5413 1, 3, 0,
7ee72033 5414 doc: /* Open a connection to an X server.
c061c855
GM		 5415DISPLAY is the name of the display to connect to.
5416Optional second arg XRM-STRING is a string of resources in xrdb format.
5417If the optional third arg MUST-SUCCEED is non-nil,
7ee72033
MB		 5418terminate Emacs if we can't open the connection. */)
5419 (display, xrm_string, must_succeed)
08a90d6a 5420 Lisp_Object display, xrm_string, must_succeed;
01f1ba30 5421{
01f1ba30 5422 unsigned char *xrm_option;
b9dc4443 5423 struct x_display_info *dpyinfo;
01f1ba30 5424
b7826503 5425 CHECK_STRING (display);
d387c960 5426 if (! NILP (xrm_string))
b7826503 5427 CHECK_STRING (xrm_string);
01f1ba30 5428
806048df
RS		 5429 if (! EQ (Vwindow_system, intern ("x")))
5430 error ("Not using X Windows");
5431
d387c960 5432 if (! NILP (xrm_string))
d5db4077 5433 xrm_option = (unsigned char *) SDATA (xrm_string);
01f1ba30
JB		 5434 else
5435 xrm_option = (unsigned char *) 0;
d387c960
JB		 5436
5437 validate_x_resource_name ();
5438
e1b1bee8 5439 /* This is what opens the connection and sets x_current_display.
b9dc4443
RS		 5440 This also initializes many symbols, such as those used for input. */
5441 dpyinfo = x_term_init (display, xrm_option,
d5db4077 5442 (char *) SDATA (Vx_resource_name));
f1c16f36 5443
08a90d6a
RS		 5444 if (dpyinfo == 0)
5445 {
5446 if (!NILP (must_succeed))
10ffbc14
GM		 5447 fatal ("Cannot connect to X server %s.\n\
5448Check the DISPLAY environment variable or use `-d'.\n\
842a9389
JB		 5449Also use the `xauth' program to verify that you have the proper\n\
5450authorization information needed to connect the X server.\n\
bf770132 5451An insecure way to solve the problem may be to use `xhost'.\n",
d5db4077 5452 SDATA (display));
08a90d6a 5453 else
d5db4077 5454 error ("Cannot connect to X server %s", SDATA (display));
08a90d6a
RS		 5455 }
5456
b9dc4443 5457 x_in_use = 1;
01f1ba30 5458
b9dc4443 5459 XSETFASTINT (Vwindow_system_version, 11);
01f1ba30
JB		 5460 return Qnil;
5461}
5462
08a90d6a
RS		 5463DEFUN ("x-close-connection", Fx_close_connection,
5464 Sx_close_connection, 1, 1, 0,
7ee72033 5465 doc: /* Close the connection to DISPLAY's X server.
c061c855 5466For DISPLAY, specify either a frame or a display name (a string).
7ee72033
MB		 5467If DISPLAY is nil, that stands for the selected frame's display. */)
5468 (display)
c061c855 5469 Lisp_Object display;
01f1ba30 5470{
08a90d6a 5471 struct x_display_info *dpyinfo = check_x_display_info (display);
08a90d6a 5472 int i;
3457bc6e 5473
08a90d6a
RS		 5474 if (dpyinfo->reference_count > 0)
5475 error ("Display still has frames on it");
01f1ba30 5476
08a90d6a
RS		 5477 BLOCK_INPUT;
5478 /* Free the fonts in the font table. */
5479 for (i = 0; i < dpyinfo->n_fonts; i++)
333b20bb
GM		 5480 if (dpyinfo->font_table[i].name)
5481 {
6ecb43ce
KH		 5482 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
5483 xfree (dpyinfo->font_table[i].full_name);
333b20bb 5484 xfree (dpyinfo->font_table[i].name);
333b20bb
GM		 5485 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5486 }
5487
08a90d6a
RS		 5488 x_destroy_all_bitmaps (dpyinfo);
5489 XSetCloseDownMode (dpyinfo->display, DestroyAll);
82c90203
RS		 5490
5491#ifdef USE_X_TOOLKIT
5492 XtCloseDisplay (dpyinfo->display);
5493#else
08a90d6a 5494 XCloseDisplay (dpyinfo->display);
82c90203 5495#endif
08a90d6a
RS		 5496
5497 x_delete_display (dpyinfo);
5498 UNBLOCK_INPUT;
3457bc6e 5499
01f1ba30
JB		 5500 return Qnil;
5501}
5502
08a90d6a 5503DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
7ee72033
MB		 5504 doc: /* Return the list of display names that Emacs has connections to. */)
5505 ()
08a90d6a
RS		 5506{
5507 Lisp_Object tail, result;
5508
5509 result = Qnil;
8e713be6
KR		 5510 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
5511 result = Fcons (XCAR (XCAR (tail)), result);
08a90d6a
RS		 5512
5513 return result;
5514}
5515
5516DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7ee72033 5517 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
c061c855
GM		 5518If ON is nil, allow buffering of requests.
5519Turning on synchronization prohibits the Xlib routines from buffering
5520requests and seriously degrades performance, but makes debugging much
5521easier.
5522The optional second argument DISPLAY specifies which display to act on.
5523DISPLAY should be either a frame or a display name (a string).
7ee72033
MB		 5524If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
5525 (on, display)
08a90d6a 5526 Lisp_Object display, on;
01f1ba30 5527{
08a90d6a 5528 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 5529
b9dc4443 5530 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
01f1ba30
JB		 5531
5532 return Qnil;
5533}
5534
b9dc4443 5535/* Wait for responses to all X commands issued so far for frame F. */
6b7b1820
RS		 5536
5537void
b9dc4443
RS		 5538x_sync (f)
5539 FRAME_PTR f;
6b7b1820 5540{
4e87f4d2 5541 BLOCK_INPUT;
b9dc4443 5542 XSync (FRAME_X_DISPLAY (f), False);
4e87f4d2 5543 UNBLOCK_INPUT;
6b7b1820 5544}
333b20bb 5545
01f1ba30 5546\f
333b20bb
GM		 5547/***********************************************************************
5548 Image types
5549 ***********************************************************************/
f1c16f36 5550
333b20bb
GM		 5551/* Value is the number of elements of vector VECTOR. */
5552
5553#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5554
5555/* List of supported image types. Use define_image_type to add new
5556 types. Use lookup_image_type to find a type for a given symbol. */
5557
5558static struct image_type *image_types;
5559
333b20bb
GM		 5560/* The symbol `image' which is the car of the lists used to represent
5561 images in Lisp. */
5562
5563extern Lisp_Object Qimage;
5564
5565/* The symbol `xbm' which is used as the type symbol for XBM images. */
5566
5567Lisp_Object Qxbm;
5568
5569/* Keywords. */
5570
0fe92f72 5571extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
77814035
KS		 5572extern Lisp_Object QCdata, QCtype;
5573Lisp_Object QCascent, QCmargin, QCrelief;
d2dc8167 5574Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4a8e312c 5575Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
333b20bb
GM		 5576
5577/* Other symbols. */
5578
4a8e312c 5579Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
333b20bb
GM		 5580
5581/* Time in seconds after which images should be removed from the cache
5582 if not displayed. */
5583
fcf431dc 5584Lisp_Object Vimage_cache_eviction_delay;
333b20bb
GM		 5585
5586/* Function prototypes. */
5587
5588static void define_image_type P_ ((struct image_type *type));
5589static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
5590static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
5591static void x_laplace P_ ((struct frame *, struct image *));
4a8e312c 5592static void x_emboss P_ ((struct frame *, struct image *));
45158a91
GM		 5593static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
5594 Lisp_Object));
333b20bb
GM		 5595
5596
5597/* Define a new image type from TYPE. This adds a copy of TYPE to
5598 image_types and adds the symbol *TYPE->type to Vimage_types. */
5599
5600static void
5601define_image_type (type)
5602 struct image_type *type;
5603{
5604 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5605 The initialized data segment is read-only. */
5606 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
5607 bcopy (type, p, sizeof *p);
5608 p->next = image_types;
5609 image_types = p;
5610 Vimage_types = Fcons (*p->type, Vimage_types);
5611}
5612
5613
5614/* Look up image type SYMBOL, and return a pointer to its image_type
5615 structure. Value is null if SYMBOL is not a known image type. */
5616
5617static INLINE struct image_type *
5618lookup_image_type (symbol)
5619 Lisp_Object symbol;
5620{
5621 struct image_type *type;
5622
5623 for (type = image_types; type; type = type->next)
5624 if (EQ (symbol, *type->type))
5625 break;
5626
5627 return type;
5628}
5629
5630
5631/* Value is non-zero if OBJECT is a valid Lisp image specification. A
5632 valid image specification is a list whose car is the symbol
5633 `image', and whose rest is a property list. The property list must
5634 contain a value for key `:type'. That value must be the name of a
5635 supported image type. The rest of the property list depends on the
5636 image type. */
5637
5638int
5639valid_image_p (object)
5640 Lisp_Object object;
5641{
5642 int valid_p = 0;
488dd4c4 5643
333b20bb
GM		 5644 if (CONSP (object) && EQ (XCAR (object), Qimage))
5645 {
1783ffa2
GM		 5646 Lisp_Object tem;
5647
5648 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
5649 if (EQ (XCAR (tem), QCtype))
5650 {
5651 tem = XCDR (tem);
5652 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
5653 {
5654 struct image_type *type;
5655 type = lookup_image_type (XCAR (tem));
5656 if (type)
5657 valid_p = type->valid_p (object);
5658 }
488dd4c4 5659
1783ffa2
GM		 5660 break;
5661 }
333b20bb
GM		 5662 }
5663
5664 return valid_p;
5665}
5666
5667
7ab1745f
GM		 5668/* Log error message with format string FORMAT and argument ARG.
5669 Signaling an error, e.g. when an image cannot be loaded, is not a
5670 good idea because this would interrupt redisplay, and the error
5671 message display would lead to another redisplay. This function
5672 therefore simply displays a message. */
333b20bb
GM		 5673
5674static void
5675image_error (format, arg1, arg2)
5676 char *format;
5677 Lisp_Object arg1, arg2;
5678{
7ab1745f 5679 add_to_log (format, arg1, arg2);
333b20bb
GM		 5680}
5681
5682
5683\f
5684/***********************************************************************
5685 Image specifications
5686 ***********************************************************************/
5687
5688enum image_value_type
5689{
5690 IMAGE_DONT_CHECK_VALUE_TYPE,
5691 IMAGE_STRING_VALUE,
6f1be3b9 5692 IMAGE_STRING_OR_NIL_VALUE,
333b20bb
GM		 5693 IMAGE_SYMBOL_VALUE,
5694 IMAGE_POSITIVE_INTEGER_VALUE,
3ed61e75 5695 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
333b20bb 5696 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
7c7ff7f5 5697 IMAGE_ASCENT_VALUE,
333b20bb
GM		 5698 IMAGE_INTEGER_VALUE,
5699 IMAGE_FUNCTION_VALUE,
5700 IMAGE_NUMBER_VALUE,
5701 IMAGE_BOOL_VALUE
5702};
5703
5704/* Structure used when parsing image specifications. */
5705
5706struct image_keyword
5707{
5708 /* Name of keyword. */
5709 char *name;
5710
5711 /* The type of value allowed. */
5712 enum image_value_type type;
5713
5714 /* Non-zero means key must be present. */
5715 int mandatory_p;
5716
5717 /* Used to recognize duplicate keywords in a property list. */
5718 int count;
5719
5720 /* The value that was found. */
5721 Lisp_Object value;
5722};
5723
5724
bfd2209f
GM		 5725static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
5726 int, Lisp_Object));
333b20bb
GM		 5727static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
5728
5729
5730/* Parse image spec SPEC according to KEYWORDS. A valid image spec
5731 has the format (image KEYWORD VALUE ...). One of the keyword/
5732 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5733 image_keywords structures of size NKEYWORDS describing other
bfd2209f 5734 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
333b20bb
GM		 5735
5736static int
bfd2209f 5737parse_image_spec (spec, keywords, nkeywords, type)
333b20bb
GM		 5738 Lisp_Object spec;
5739 struct image_keyword *keywords;
5740 int nkeywords;
5741 Lisp_Object type;
333b20bb
GM		 5742{
5743 int i;
5744 Lisp_Object plist;
5745
5746 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
5747 return 0;
5748
5749 plist = XCDR (spec);
5750 while (CONSP (plist))
5751 {
5752 Lisp_Object key, value;
5753
5754 /* First element of a pair must be a symbol. */
5755 key = XCAR (plist);
5756 plist = XCDR (plist);
5757 if (!SYMBOLP (key))
5758 return 0;
5759
5760 /* There must follow a value. */
5761 if (!CONSP (plist))
5762 return 0;
5763 value = XCAR (plist);
5764 plist = XCDR (plist);
5765
5766 /* Find key in KEYWORDS. Error if not found. */
5767 for (i = 0; i < nkeywords; ++i)
d5db4077 5768 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
333b20bb
GM		 5769 break;
5770
5771 if (i == nkeywords)
bfd2209f 5772 continue;
333b20bb
GM		 5773
5774 /* Record that we recognized the keyword. If a keywords
5775 was found more than once, it's an error. */
5776 keywords[i].value = value;
5777 ++keywords[i].count;
488dd4c4 5778
333b20bb
GM		 5779 if (keywords[i].count > 1)
5780 return 0;
5781
5782 /* Check type of value against allowed type. */
5783 switch (keywords[i].type)
5784 {
5785 case IMAGE_STRING_VALUE:
5786 if (!STRINGP (value))
5787 return 0;
5788 break;
5789
6f1be3b9
GM		 5790 case IMAGE_STRING_OR_NIL_VALUE:
5791 if (!STRINGP (value) && !NILP (value))
5792 return 0;
5793 break;
5794
333b20bb
GM		 5795 case IMAGE_SYMBOL_VALUE:
5796 if (!SYMBOLP (value))
5797 return 0;
5798 break;
5799
5800 case IMAGE_POSITIVE_INTEGER_VALUE:
5801 if (!INTEGERP (value) || XINT (value) <= 0)
5802 return 0;
5803 break;
5804
3ed61e75
GM		 5805 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
5806 if (INTEGERP (value) && XINT (value) >= 0)
5807 break;
5808 if (CONSP (value)
5809 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
5810 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
5811 break;
5812 return 0;
5813
7c7ff7f5
GM		 5814 case IMAGE_ASCENT_VALUE:
5815 if (SYMBOLP (value) && EQ (value, Qcenter))
5816 break;
5817 else if (INTEGERP (value)
5818 && XINT (value) >= 0
5819 && XINT (value) <= 100)
5820 break;
5821 return 0;
488dd4c4 5822
333b20bb
GM		 5823 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
5824 if (!INTEGERP (value) || XINT (value) < 0)
5825 return 0;
5826 break;
5827
5828 case IMAGE_DONT_CHECK_VALUE_TYPE:
5829 break;
5830
5831 case IMAGE_FUNCTION_VALUE:
5832 value = indirect_function (value);
488dd4c4 5833 if (SUBRP (value)
333b20bb
GM		 5834 || COMPILEDP (value)
5835 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
5836 break;
5837 return 0;
5838
5839 case IMAGE_NUMBER_VALUE:
5840 if (!INTEGERP (value) && !FLOATP (value))
5841 return 0;
5842 break;
5843
5844 case IMAGE_INTEGER_VALUE:
5845 if (!INTEGERP (value))
5846 return 0;
5847 break;
5848
5849 case IMAGE_BOOL_VALUE:
5850 if (!NILP (value) && !EQ (value, Qt))
5851 return 0;
5852 break;
5853
5854 default:
5855 abort ();
5856 break;
5857 }
5858
5859 if (EQ (key, QCtype) && !EQ (type, value))
5860 return 0;
5861 }
5862
5863 /* Check that all mandatory fields are present. */
5864 for (i = 0; i < nkeywords; ++i)
5865 if (keywords[i].mandatory_p && keywords[i].count == 0)
5866 return 0;
5867
5868 return NILP (plist);
5869}
5870
5871
5872/* Return the value of KEY in image specification SPEC. Value is nil
5873 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5874 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5875
5876static Lisp_Object
5877image_spec_value (spec, key, found)
5878 Lisp_Object spec, key;
5879 int *found;
5880{
5881 Lisp_Object tail;
488dd4c4 5882
333b20bb
GM		 5883 xassert (valid_image_p (spec));
5884
5885 for (tail = XCDR (spec);
5886 CONSP (tail) && CONSP (XCDR (tail));
5887 tail = XCDR (XCDR (tail)))
5888 {
5889 if (EQ (XCAR (tail), key))
5890 {
5891 if (found)
5892 *found = 1;
5893 return XCAR (XCDR (tail));
5894 }
5895 }
488dd4c4 5896
333b20bb
GM		 5897 if (found)
5898 *found = 0;
5899 return Qnil;
5900}
488dd4c4 5901
333b20bb 5902
42677916 5903DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
7ee72033 5904 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
c061c855
GM		 5905PIXELS non-nil means return the size in pixels, otherwise return the
5906size in canonical character units.
5907FRAME is the frame on which the image will be displayed. FRAME nil
7ee72033
MB		 5908or omitted means use the selected frame. */)
5909 (spec, pixels, frame)
42677916
GM		 5910 Lisp_Object spec, pixels, frame;
5911{
5912 Lisp_Object size;
5913
5914 size = Qnil;
5915 if (valid_image_p (spec))
5916 {
5917 struct frame *f = check_x_frame (frame);
83676598 5918 int id = lookup_image (f, spec);
42677916 5919 struct image *img = IMAGE_FROM_ID (f, id);
3ed61e75
GM		 5920 int width = img->width + 2 * img->hmargin;
5921 int height = img->height + 2 * img->vmargin;
488dd4c4 5922
42677916
GM		 5923 if (NILP (pixels))
5924 size = Fcons (make_float ((double) width / CANON_X_UNIT (f)),
5925 make_float ((double) height / CANON_Y_UNIT (f)));
5926 else
5927 size = Fcons (make_number (width), make_number (height));
5928 }
5929 else
5930 error ("Invalid image specification");
5931
5932 return size;
5933}
5934
333b20bb 5935
b243755a 5936DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
7ee72033 5937 doc: /* Return t if image SPEC has a mask bitmap.
c061c855 5938FRAME is the frame on which the image will be displayed. FRAME nil
7ee72033
MB		 5939or omitted means use the selected frame. */)
5940 (spec, frame)
b243755a
GM		 5941 Lisp_Object spec, frame;
5942{
5943 Lisp_Object mask;
5944
5945 mask = Qnil;
5946 if (valid_image_p (spec))
5947 {
5948 struct frame *f = check_x_frame (frame);
83676598 5949 int id = lookup_image (f, spec);
b243755a
GM		 5950 struct image *img = IMAGE_FROM_ID (f, id);
5951 if (img->mask)
5952 mask = Qt;
5953 }
5954 else
5955 error ("Invalid image specification");
5956
5957 return mask;
5958}
5959
5960
333b20bb
GM		 5961\f
5962/***********************************************************************
5963 Image type independent image structures
5964 ***********************************************************************/
5965
5966static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
5967static void free_image P_ ((struct frame *f, struct image *img));
5968
5969
5970/* Allocate and return a new image structure for image specification
5971 SPEC. SPEC has a hash value of HASH. */
5972
5973static struct image *
5974make_image (spec, hash)
5975 Lisp_Object spec;
5976 unsigned hash;
5977{
5978 struct image *img = (struct image *) xmalloc (sizeof *img);
488dd4c4 5979
333b20bb
GM		 5980 xassert (valid_image_p (spec));
5981 bzero (img, sizeof *img);
5982 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
5983 xassert (img->type != NULL);
5984 img->spec = spec;
5985 img->data.lisp_val = Qnil;
5986 img->ascent = DEFAULT_IMAGE_ASCENT;
5987 img->hash = hash;
5988 return img;
5989}
5990
5991
5992/* Free image IMG which was used on frame F, including its resources. */
5993
5994static void
5995free_image (f, img)
5996 struct frame *f;
5997 struct image *img;
5998{
5999 if (img)
6000 {
6001 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6002
6003 /* Remove IMG from the hash table of its cache. */
6004 if (img->prev)
6005 img->prev->next = img->next;
6006 else
6007 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
6008
6009 if (img->next)
6010 img->next->prev = img->prev;
6011
6012 c->images[img->id] = NULL;
6013
6014 /* Free resources, then free IMG. */
6015 img->type->free (f, img);
6016 xfree (img);
6017 }
6018}
6019
6020
6021/* Prepare image IMG for display on frame F. Must be called before
6022 drawing an image. */
6023
6024void
6025prepare_image_for_display (f, img)
6026 struct frame *f;
6027 struct image *img;
6028{
6029 EMACS_TIME t;
6030
6031 /* We're about to display IMG, so set its timestamp to `now'. */
6032 EMACS_GET_TIME (t);
6033 img->timestamp = EMACS_SECS (t);
6034
6035 /* If IMG doesn't have a pixmap yet, load it now, using the image
6036 type dependent loader function. */
dd00328a 6037 if (img->pixmap == None && !img->load_failed_p)
209061be 6038 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb 6039}
488dd4c4 6040
333b20bb 6041
7c7ff7f5
GM		 6042/* Value is the number of pixels for the ascent of image IMG when
6043 drawn in face FACE. */
6044
6045int
6046image_ascent (img, face)
6047 struct image *img;
6048 struct face *face;
6049{
3ed61e75 6050 int height = img->height + img->vmargin;
7c7ff7f5
GM		 6051 int ascent;
6052
6053 if (img->ascent == CENTERED_IMAGE_ASCENT)
6054 {
6055 if (face->font)
3694cb3f
MB		 6056 /* This expression is arranged so that if the image can't be
6057 exactly centered, it will be moved slightly up. This is
6058 because a typical font is `top-heavy' (due to the presence
6059 uppercase letters), so the image placement should err towards
6060 being top-heavy too. It also just generally looks better. */
6061 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
7c7ff7f5
GM		 6062 else
6063 ascent = height / 2;
6064 }
6065 else
6066 ascent = height * img->ascent / 100.0;
6067
6068 return ascent;
6069}
6070
f20a3b7a
MB		 6071\f
6072/* Image background colors. */
6073
6074static unsigned long
6075four_corners_best (ximg, width, height)
6076 XImage *ximg;
6077 unsigned long width, height;
6078{
b350c2e5
GM		 6079 unsigned long corners[4], best;
6080 int i, best_count;
f20a3b7a 6081
b350c2e5
GM		 6082 /* Get the colors at the corners of ximg. */
6083 corners[0] = XGetPixel (ximg, 0, 0);
6084 corners[1] = XGetPixel (ximg, width - 1, 0);
6085 corners[2] = XGetPixel (ximg, width - 1, height - 1);
6086 corners[3] = XGetPixel (ximg, 0, height - 1);
f20a3b7a 6087
b350c2e5
GM		 6088 /* Choose the most frequently found color as background. */
6089 for (i = best_count = 0; i < 4; ++i)
6090 {
6091 int j, n;
488dd4c4 6092
b350c2e5
GM		 6093 for (j = n = 0; j < 4; ++j)
6094 if (corners[i] == corners[j])
6095 ++n;
f20a3b7a 6096
b350c2e5
GM		 6097 if (n > best_count)
6098 best = corners[i], best_count = n;
6099 }
f20a3b7a 6100
b350c2e5 6101 return best;
f20a3b7a
MB		 6102}
6103
6104/* Return the `background' field of IMG. If IMG doesn't have one yet,
6105 it is guessed heuristically. If non-zero, XIMG is an existing XImage
6106 object to use for the heuristic. */
6107
6108unsigned long
6109image_background (img, f, ximg)
6110 struct image *img;
6111 struct frame *f;
6112 XImage *ximg;
6113{
6114 if (! img->background_valid)
6115 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6116 {
6117 int free_ximg = !ximg;
6118
6119 if (! ximg)
6120 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
6121 0, 0, img->width, img->height, ~0, ZPixmap);
6122
6123 img->background = four_corners_best (ximg, img->width, img->height);
6124
6125 if (free_ximg)
6126 XDestroyImage (ximg);
6127
6128 img->background_valid = 1;
6129 }
6130
6131 return img->background;
6132}
6133
6134/* Return the `background_transparent' field of IMG. If IMG doesn't
6135 have one yet, it is guessed heuristically. If non-zero, MASK is an
6136 existing XImage object to use for the heuristic. */
6137
6138int
6139image_background_transparent (img, f, mask)
6140 struct image *img;
6141 struct frame *f;
6142 XImage *mask;
6143{
6144 if (! img->background_transparent_valid)
6145 /* IMG doesn't have a background yet, try to guess a reasonable value. */
6146 {
6147 if (img->mask)
6148 {
6149 int free_mask = !mask;
6150
6151 if (! mask)
6152 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
6153 0, 0, img->width, img->height, ~0, ZPixmap);
6154
6155 img->background_transparent
6156 = !four_corners_best (mask, img->width, img->height);
6157
6158 if (free_mask)
6159 XDestroyImage (mask);
6160 }
6161 else
6162 img->background_transparent = 0;
6163
6164 img->background_transparent_valid = 1;
6165 }
6166
6167 return img->background_transparent;
6168}
7c7ff7f5 6169
333b20bb
GM		 6170\f
6171/***********************************************************************
6172 Helper functions for X image types
6173 ***********************************************************************/
6174
dd00328a
GM		 6175static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
6176 int, int));
333b20bb
GM		 6177static void x_clear_image P_ ((struct frame *f, struct image *img));
6178static unsigned long x_alloc_image_color P_ ((struct frame *f,
6179 struct image *img,
6180 Lisp_Object color_name,
6181 unsigned long dflt));
6182
dd00328a
GM		 6183
6184/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
6185 free the pixmap if any. MASK_P non-zero means clear the mask
6186 pixmap if any. COLORS_P non-zero means free colors allocated for
6187 the image, if any. */
333b20bb
GM		 6188
6189static void
dd00328a 6190x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
333b20bb
GM		 6191 struct frame *f;
6192 struct image *img;
dd00328a 6193 int pixmap_p, mask_p, colors_p;
333b20bb 6194{
dd00328a 6195 if (pixmap_p && img->pixmap)
333b20bb 6196 {
333b20bb 6197 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 6198 img->pixmap = None;
f20a3b7a 6199 img->background_valid = 0;
f4779de9
GM		 6200 }
6201
dd00328a 6202 if (mask_p && img->mask)
f4779de9
GM		 6203 {
6204 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 6205 img->mask = None;
f20a3b7a 6206 img->background_transparent_valid = 0;
333b20bb 6207 }
488dd4c4 6208
dd00328a 6209 if (colors_p && img->ncolors)
333b20bb 6210 {
462d5d40 6211 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM		 6212 xfree (img->colors);
6213 img->colors = NULL;
6214 img->ncolors = 0;
6215 }
dd00328a
GM		 6216}
6217
6218/* Free X resources of image IMG which is used on frame F. */
6219
6220static void
6221x_clear_image (f, img)
6222 struct frame *f;
6223 struct image *img;
6224{
6225 BLOCK_INPUT;
6226 x_clear_image_1 (f, img, 1, 1, 1);
f4779de9 6227 UNBLOCK_INPUT;
333b20bb
GM		 6228}
6229
6230
6231/* Allocate color COLOR_NAME for image IMG on frame F. If color
6232 cannot be allocated, use DFLT. Add a newly allocated color to
6233 IMG->colors, so that it can be freed again. Value is the pixel
6234 color. */
6235
6236static unsigned long
6237x_alloc_image_color (f, img, color_name, dflt)
6238 struct frame *f;
6239 struct image *img;
6240 Lisp_Object color_name;
6241 unsigned long dflt;
6242{
6243 XColor color;
6244 unsigned long result;
6245
6246 xassert (STRINGP (color_name));
6247
d5db4077 6248 if (x_defined_color (f, SDATA (color_name), &color, 1))
333b20bb
GM		 6249 {
6250 /* This isn't called frequently so we get away with simply
6251 reallocating the color vector to the needed size, here. */
6252 ++img->ncolors;
6253 img->colors =
6254 (unsigned long *) xrealloc (img->colors,
6255 img->ncolors * sizeof *img->colors);
6256 img->colors[img->ncolors - 1] = color.pixel;
6257 result = color.pixel;
6258 }
6259 else
6260 result = dflt;
6261
6262 return result;
6263}
6264
6265
6266\f
6267/***********************************************************************
6268 Image Cache
6269 ***********************************************************************/
6270
6271static void cache_image P_ ((struct frame *f, struct image *img));
ad18ffb1 6272static void postprocess_image P_ ((struct frame *, struct image *));
333b20bb
GM		 6273
6274
6275/* Return a new, initialized image cache that is allocated from the
6276 heap. Call free_image_cache to free an image cache. */
6277
6278struct image_cache *
6279make_image_cache ()
6280{
6281 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
6282 int size;
488dd4c4 6283
333b20bb
GM		 6284 bzero (c, sizeof *c);
6285 c->size = 50;
6286 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
6287 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
6288 c->buckets = (struct image **) xmalloc (size);
6289 bzero (c->buckets, size);
6290 return c;
6291}
6292
6293
6294/* Free image cache of frame F. Be aware that X frames share images
6295 caches. */
6296
6297void
6298free_image_cache (f)
6299 struct frame *f;
6300{
6301 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6302 if (c)
6303 {
6304 int i;
6305
6306 /* Cache should not be referenced by any frame when freed. */
6307 xassert (c->refcount == 0);
488dd4c4 6308
333b20bb
GM		 6309 for (i = 0; i < c->used; ++i)
6310 free_image (f, c->images[i]);
6311 xfree (c->images);
333b20bb 6312 xfree (c->buckets);
e3130015 6313 xfree (c);
333b20bb
GM		 6314 FRAME_X_IMAGE_CACHE (f) = NULL;
6315 }
6316}
6317
6318
6319/* Clear image cache of frame F. FORCE_P non-zero means free all
6320 images. FORCE_P zero means clear only images that haven't been
6321 displayed for some time. Should be called from time to time to
6322 reduce the number of loaded images. If image-eviction-seconds is
6323 non-nil, this frees images in the cache which weren't displayed for
6324 at least that many seconds. */
6325
6326void
6327clear_image_cache (f, force_p)
6328 struct frame *f;
6329 int force_p;
6330{
6331 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6332
83676598 6333 if (c && INTEGERP (Vimage_cache_eviction_delay))
333b20bb
GM		 6334 {
6335 EMACS_TIME t;
6336 unsigned long old;
f4779de9 6337 int i, nfreed;
333b20bb
GM		 6338
6339 EMACS_GET_TIME (t);
fcf431dc 6340 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
f4779de9
GM		 6341
6342 /* Block input so that we won't be interrupted by a SIGIO
6343 while being in an inconsistent state. */
6344 BLOCK_INPUT;
488dd4c4 6345
f4779de9 6346 for (i = nfreed = 0; i < c->used; ++i)
333b20bb
GM		 6347 {
6348 struct image *img = c->images[i];
6349 if (img != NULL
f4779de9 6350 && (force_p || img->timestamp < old))
333b20bb
GM		 6351 {
6352 free_image (f, img);
f4779de9 6353 ++nfreed;
333b20bb
GM		 6354 }
6355 }
6356
6357 /* We may be clearing the image cache because, for example,
6358 Emacs was iconified for a longer period of time. In that
6359 case, current matrices may still contain references to
6360 images freed above. So, clear these matrices. */
f4779de9 6361 if (nfreed)
333b20bb 6362 {
f4779de9 6363 Lisp_Object tail, frame;
488dd4c4 6364
f4779de9
GM		 6365 FOR_EACH_FRAME (tail, frame)
6366 {
6367 struct frame *f = XFRAME (frame);
6368 if (FRAME_X_P (f)
6369 && FRAME_X_IMAGE_CACHE (f) == c)
83676598 6370 clear_current_matrices (f);
f4779de9
GM		 6371 }
6372
333b20bb
GM		 6373 ++windows_or_buffers_changed;
6374 }
f4779de9
GM		 6375
6376 UNBLOCK_INPUT;
333b20bb
GM		 6377 }
6378}
6379
6380
6381DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
6382 0, 1, 0,
7ee72033 6383 doc: /* Clear the image cache of FRAME.
c061c855 6384FRAME nil or omitted means use the selected frame.
7ee72033
MB		 6385FRAME t means clear the image caches of all frames. */)
6386 (frame)
333b20bb
GM		 6387 Lisp_Object frame;
6388{
6389 if (EQ (frame, Qt))
6390 {
6391 Lisp_Object tail;
488dd4c4 6392
333b20bb
GM		 6393 FOR_EACH_FRAME (tail, frame)
6394 if (FRAME_X_P (XFRAME (frame)))
6395 clear_image_cache (XFRAME (frame), 1);
6396 }
6397 else
6398 clear_image_cache (check_x_frame (frame), 1);
6399
6400 return Qnil;
6401}
6402
6403
ad18ffb1
GM		 6404/* Compute masks and transform image IMG on frame F, as specified
6405 by the image's specification, */
6406
6407static void
6408postprocess_image (f, img)
6409 struct frame *f;
6410 struct image *img;
6411{
6412 /* Manipulation of the image's mask. */
6413 if (img->pixmap)
6414 {
6415 Lisp_Object conversion, spec;
6416 Lisp_Object mask;
6417
6418 spec = img->spec;
488dd4c4 6419
ad18ffb1
GM		 6420 /* `:heuristic-mask t'
6421 `:mask heuristic'
6422 means build a mask heuristically.
6423 `:heuristic-mask (R G B)'
6424 `:mask (heuristic (R G B))'
6425 means build a mask from color (R G B) in the
6426 image.
6427 `:mask nil'
6428 means remove a mask, if any. */
488dd4c4 6429
ad18ffb1
GM		 6430 mask = image_spec_value (spec, QCheuristic_mask, NULL);
6431 if (!NILP (mask))
6432 x_build_heuristic_mask (f, img, mask);
6433 else
6434 {
6435 int found_p;
488dd4c4 6436
ad18ffb1 6437 mask = image_spec_value (spec, QCmask, &found_p);
488dd4c4 6438
ad18ffb1
GM		 6439 if (EQ (mask, Qheuristic))
6440 x_build_heuristic_mask (f, img, Qt);
6441 else if (CONSP (mask)
6442 && EQ (XCAR (mask), Qheuristic))
6443 {
6444 if (CONSP (XCDR (mask)))
6445 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
6446 else
6447 x_build_heuristic_mask (f, img, XCDR (mask));
6448 }
6449 else if (NILP (mask) && found_p && img->mask)
6450 {
6451 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
6452 img->mask = None;
6453 }
6454 }
488dd4c4
JD		 6455
6456
ad18ffb1
GM		 6457 /* Should we apply an image transformation algorithm? */
6458 conversion = image_spec_value (spec, QCconversion, NULL);
6459 if (EQ (conversion, Qdisabled))
6460 x_disable_image (f, img);
6461 else if (EQ (conversion, Qlaplace))
6462 x_laplace (f, img);
6463 else if (EQ (conversion, Qemboss))
6464 x_emboss (f, img);
6465 else if (CONSP (conversion)
6466 && EQ (XCAR (conversion), Qedge_detection))
6467 {
6468 Lisp_Object tem;
6469 tem = XCDR (conversion);
6470 if (CONSP (tem))
6471 x_edge_detection (f, img,
6472 Fplist_get (tem, QCmatrix),
6473 Fplist_get (tem, QCcolor_adjustment));
6474 }
6475 }
6476}
6477
6478
333b20bb 6479/* Return the id of image with Lisp specification SPEC on frame F.
83676598 6480 SPEC must be a valid Lisp image specification (see valid_image_p). */
333b20bb
GM		 6481
6482int
83676598 6483lookup_image (f, spec)
333b20bb
GM		 6484 struct frame *f;
6485 Lisp_Object spec;
6486{
6487 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6488 struct image *img;
6489 int i;
6490 unsigned hash;
6491 struct gcpro gcpro1;
4f7ca1f1 6492 EMACS_TIME now;
333b20bb
GM		 6493
6494 /* F must be a window-system frame, and SPEC must be a valid image
6495 specification. */
6496 xassert (FRAME_WINDOW_P (f));
6497 xassert (valid_image_p (spec));
488dd4c4 6498
333b20bb
GM		 6499 GCPRO1 (spec);
6500
6501 /* Look up SPEC in the hash table of the image cache. */
6502 hash = sxhash (spec, 0);
6503 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
6504
6505 for (img = c->buckets[i]; img; img = img->next)
6506 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
6507 break;
6508
6509 /* If not found, create a new image and cache it. */
6510 if (img == NULL)
6511 {
ad18ffb1 6512 extern Lisp_Object Qpostscript;
488dd4c4 6513
28c7826c 6514 BLOCK_INPUT;
333b20bb
GM		 6515 img = make_image (spec, hash);
6516 cache_image (f, img);
83676598 6517 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb
GM		 6518
6519 /* If we can't load the image, and we don't have a width and
6520 height, use some arbitrary width and height so that we can
6521 draw a rectangle for it. */
83676598 6522 if (img->load_failed_p)
333b20bb
GM		 6523 {
6524 Lisp_Object value;
6525
6526 value = image_spec_value (spec, QCwidth, NULL);
6527 img->width = (INTEGERP (value)
6528 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
6529 value = image_spec_value (spec, QCheight, NULL);
6530 img->height = (INTEGERP (value)
6531 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
6532 }
6533 else
6534 {
6535 /* Handle image type independent image attributes
f20a3b7a
MB		 6536 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
6537 `:background COLOR'. */
6538 Lisp_Object ascent, margin, relief, bg;
333b20bb
GM		 6539
6540 ascent = image_spec_value (spec, QCascent, NULL);
6541 if (INTEGERP (ascent))
6542 img->ascent = XFASTINT (ascent);
7c7ff7f5
GM		 6543 else if (EQ (ascent, Qcenter))
6544 img->ascent = CENTERED_IMAGE_ASCENT;
488dd4c4 6545
333b20bb
GM		 6546 margin = image_spec_value (spec, QCmargin, NULL);
6547 if (INTEGERP (margin) && XINT (margin) >= 0)
3ed61e75
GM		 6548 img->vmargin = img->hmargin = XFASTINT (margin);
6549 else if (CONSP (margin) && INTEGERP (XCAR (margin))
6550 && INTEGERP (XCDR (margin)))
6551 {
6552 if (XINT (XCAR (margin)) > 0)
6553 img->hmargin = XFASTINT (XCAR (margin));
6554 if (XINT (XCDR (margin)) > 0)
6555 img->vmargin = XFASTINT (XCDR (margin));
6556 }
488dd4c4 6557
333b20bb
GM		 6558 relief = image_spec_value (spec, QCrelief, NULL);
6559 if (INTEGERP (relief))
6560 {
6561 img->relief = XINT (relief);
3ed61e75
GM		 6562 img->hmargin += abs (img->relief);
6563 img->vmargin += abs (img->relief);
333b20bb
GM		 6564 }
6565
f20a3b7a
MB		 6566 if (! img->background_valid)
6567 {
6568 bg = image_spec_value (img->spec, QCbackground, NULL);
6569 if (!NILP (bg))
6570 {
6571 img->background
6572 = x_alloc_image_color (f, img, bg,
6573 FRAME_BACKGROUND_PIXEL (f));
6574 img->background_valid = 1;
6575 }
6576 }
6577
ad18ffb1
GM		 6578 /* Do image transformations and compute masks, unless we
6579 don't have the image yet. */
6580 if (!EQ (*img->type->type, Qpostscript))
6581 postprocess_image (f, img);
333b20bb 6582 }
dd00328a 6583
28c7826c
GM		 6584 UNBLOCK_INPUT;
6585 xassert (!interrupt_input_blocked);
333b20bb
GM		 6586 }
6587
4f7ca1f1
GM		 6588 /* We're using IMG, so set its timestamp to `now'. */
6589 EMACS_GET_TIME (now);
6590 img->timestamp = EMACS_SECS (now);
488dd4c4 6591
333b20bb 6592 UNGCPRO;
488dd4c4 6593
333b20bb
GM		 6594 /* Value is the image id. */
6595 return img->id;
6596}
6597
6598
6599/* Cache image IMG in the image cache of frame F. */
6600
6601static void
6602cache_image (f, img)
6603 struct frame *f;
6604 struct image *img;
6605{
6606 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6607 int i;
6608
6609 /* Find a free slot in c->images. */
6610 for (i = 0; i < c->used; ++i)
6611 if (c->images[i] == NULL)
6612 break;
6613
6614 /* If no free slot found, maybe enlarge c->images. */
6615 if (i == c->used && c->used == c->size)
6616 {
6617 c->size *= 2;
6618 c->images = (struct image **) xrealloc (c->images,
6619 c->size * sizeof *c->images);
6620 }
6621
6622 /* Add IMG to c->images, and assign IMG an id. */
6623 c->images[i] = img;
6624 img->id = i;
6625 if (i == c->used)
6626 ++c->used;
6627
6628 /* Add IMG to the cache's hash table. */
6629 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
6630 img->next = c->buckets[i];
6631 if (img->next)
6632 img->next->prev = img;
6633 img->prev = NULL;
6634 c->buckets[i] = img;
6635}
6636
6637
6638/* Call FN on every image in the image cache of frame F. Used to mark
6639 Lisp Objects in the image cache. */
6640
6641void
6642forall_images_in_image_cache (f, fn)
6643 struct frame *f;
6644 void (*fn) P_ ((struct image *img));
6645{
6646 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
6647 {
6648 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6649 if (c)
6650 {
6651 int i;
6652 for (i = 0; i < c->used; ++i)
6653 if (c->images[i])
6654 fn (c->images[i]);
6655 }
6656 }
6657}
6658
6659
6660\f
6661/***********************************************************************
6662 X support code
6663 ***********************************************************************/
6664
45158a91
GM		 6665static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
6666 XImage **, Pixmap *));
333b20bb
GM		 6667static void x_destroy_x_image P_ ((XImage *));
6668static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
6669
6670
6671/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6672 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6673 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6674 via xmalloc. Print error messages via image_error if an error
45158a91 6675 occurs. Value is non-zero if successful. */
333b20bb
GM		 6676
6677static int
45158a91 6678x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
333b20bb 6679 struct frame *f;
333b20bb
GM		 6680 int width, height, depth;
6681 XImage **ximg;
6682 Pixmap *pixmap;
6683{
6684 Display *display = FRAME_X_DISPLAY (f);
6685 Screen *screen = FRAME_X_SCREEN (f);
6686 Window window = FRAME_X_WINDOW (f);
6687
6688 xassert (interrupt_input_blocked);
6689
6690 if (depth <= 0)
6691 depth = DefaultDepthOfScreen (screen);
6692 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
6693 depth, ZPixmap, 0, NULL, width, height,
6694 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
6695 if (*ximg == NULL)
6696 {
45158a91 6697 image_error ("Unable to allocate X image", Qnil, Qnil);
333b20bb
GM		 6698 return 0;
6699 }
6700
6701 /* Allocate image raster. */
6702 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
6703
6704 /* Allocate a pixmap of the same size. */
6705 *pixmap = XCreatePixmap (display, window, width, height, depth);
dd00328a 6706 if (*pixmap == None)
333b20bb
GM		 6707 {
6708 x_destroy_x_image (*ximg);
6709 *ximg = NULL;
45158a91 6710 image_error ("Unable to create X pixmap", Qnil, Qnil);
333b20bb
GM		 6711 return 0;
6712 }
6713
6714 return 1;
6715}
6716
6717
6718/* Destroy XImage XIMG. Free XIMG->data. */
6719
6720static void
6721x_destroy_x_image (ximg)
6722 XImage *ximg;
6723{
6724 xassert (interrupt_input_blocked);
6725 if (ximg)
6726 {
6727 xfree (ximg->data);
6728 ximg->data = NULL;
6729 XDestroyImage (ximg);
6730 }
6731}
6732
6733
6734/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6735 are width and height of both the image and pixmap. */
6736
ea6b19ca 6737static void
333b20bb
GM		 6738x_put_x_image (f, ximg, pixmap, width, height)
6739 struct frame *f;
6740 XImage *ximg;
6741 Pixmap pixmap;
caeea55a 6742 int width, height;
333b20bb
GM		 6743{
6744 GC gc;
488dd4c4 6745
333b20bb
GM		 6746 xassert (interrupt_input_blocked);
6747 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
6748 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
6749 XFreeGC (FRAME_X_DISPLAY (f), gc);
6750}
6751
6752
6753\f
6754/***********************************************************************
5be6c3b0 6755 File Handling
333b20bb
GM		 6756 ***********************************************************************/
6757
6758static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5be6c3b0
GM		 6759static char *slurp_file P_ ((char *, int *));
6760
333b20bb
GM		 6761
6762/* Find image file FILE. Look in data-directory, then
6763 x-bitmap-file-path. Value is the full name of the file found, or
6764 nil if not found. */
6765
6766static Lisp_Object
6767x_find_image_file (file)
6768 Lisp_Object file;
6769{
6770 Lisp_Object file_found, search_path;
6771 struct gcpro gcpro1, gcpro2;
6772 int fd;
6773
6774 file_found = Qnil;
6775 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
6776 GCPRO2 (file_found, search_path);
6777
6778 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
de2413e9 6779 fd = openp (search_path, file, Qnil, &file_found, Qnil);
488dd4c4 6780
939d6465 6781 if (fd == -1)
333b20bb
GM		 6782 file_found = Qnil;
6783 else
6784 close (fd);
6785
6786 UNGCPRO;
6787 return file_found;
6788}
6789
6790
5be6c3b0
GM		 6791/* Read FILE into memory. Value is a pointer to a buffer allocated
6792 with xmalloc holding FILE's contents. Value is null if an error
b243755a 6793 occurred. *SIZE is set to the size of the file. */
5be6c3b0
GM		 6794
6795static char *
6796slurp_file (file, size)
6797 char *file;
6798 int *size;
6799{
6800 FILE *fp = NULL;
6801 char *buf = NULL;
6802 struct stat st;
6803
6804 if (stat (file, &st) == 0
6805 && (fp = fopen (file, "r")) != NULL
6806 && (buf = (char *) xmalloc (st.st_size),
6807 fread (buf, 1, st.st_size, fp) == st.st_size))
6808 {
6809 *size = st.st_size;
6810 fclose (fp);
6811 }
6812 else
6813 {
6814 if (fp)
6815 fclose (fp);
6816 if (buf)
6817 {
6818 xfree (buf);
6819 buf = NULL;
6820 }
6821 }
488dd4c4 6822
5be6c3b0
GM		 6823 return buf;
6824}
6825
6826
333b20bb
GM		 6827\f
6828/***********************************************************************
6829 XBM images
6830 ***********************************************************************/
6831
5be6c3b0 6832static int xbm_scan P_ ((char **, char *, char *, int *));
333b20bb 6833static int xbm_load P_ ((struct frame *f, struct image *img));
5be6c3b0
GM		 6834static int xbm_load_image P_ ((struct frame *f, struct image *img,
6835 char *, char *));
333b20bb 6836static int xbm_image_p P_ ((Lisp_Object object));
5be6c3b0
GM		 6837static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
6838 unsigned char **));
6839static int xbm_file_p P_ ((Lisp_Object));
333b20bb
GM		 6840
6841
6842/* Indices of image specification fields in xbm_format, below. */
6843
6844enum xbm_keyword_index
6845{
6846 XBM_TYPE,
6847 XBM_FILE,
6848 XBM_WIDTH,
6849 XBM_HEIGHT,
6850 XBM_DATA,
6851 XBM_FOREGROUND,
6852 XBM_BACKGROUND,
6853 XBM_ASCENT,
6854 XBM_MARGIN,
6855 XBM_RELIEF,
6856 XBM_ALGORITHM,
6857 XBM_HEURISTIC_MASK,
4a8e312c 6858 XBM_MASK,
333b20bb
GM		 6859 XBM_LAST
6860};
6861
6862/* Vector of image_keyword structures describing the format
6863 of valid XBM image specifications. */
6864
6865static struct image_keyword xbm_format[XBM_LAST] =
6866{
6867 {":type", IMAGE_SYMBOL_VALUE, 1},
6868 {":file", IMAGE_STRING_VALUE, 0},
6869 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6870 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6871 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM		 6872 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
6873 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
7c7ff7f5 6874 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 6875 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 6876 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 6877 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 6878 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6879 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 6880};
6881
6882/* Structure describing the image type XBM. */
6883
6884static struct image_type xbm_type =
6885{
6886 &Qxbm,
6887 xbm_image_p,
6888 xbm_load,
6889 x_clear_image,
6890 NULL
6891};
6892
6893/* Tokens returned from xbm_scan. */
6894
6895enum xbm_token
6896{
6897 XBM_TK_IDENT = 256,
6898 XBM_TK_NUMBER
6899};
6900
488dd4c4 6901
333b20bb
GM		 6902/* Return non-zero if OBJECT is a valid XBM-type image specification.
6903 A valid specification is a list starting with the symbol `image'
6904 The rest of the list is a property list which must contain an
6905 entry `:type xbm..
6906
6907 If the specification specifies a file to load, it must contain
6908 an entry `:file FILENAME' where FILENAME is a string.
6909
6910 If the specification is for a bitmap loaded from memory it must
6911 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6912 WIDTH and HEIGHT are integers > 0. DATA may be:
6913
6914 1. a string large enough to hold the bitmap data, i.e. it must
6915 have a size >= (WIDTH + 7) / 8 * HEIGHT
6916
6917 2. a bool-vector of size >= WIDTH * HEIGHT
6918
6919 3. a vector of strings or bool-vectors, one for each line of the
6920 bitmap.
6921
5be6c3b0
GM		 6922 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6923 may not be specified in this case because they are defined in the
6924 XBM file.
6925
333b20bb
GM		 6926 Both the file and data forms may contain the additional entries
6927 `:background COLOR' and `:foreground COLOR'. If not present,
6928 foreground and background of the frame on which the image is
e3130015 6929 displayed is used. */
333b20bb
GM		 6930
6931static int
6932xbm_image_p (object)
6933 Lisp_Object object;
6934{
6935 struct image_keyword kw[XBM_LAST];
488dd4c4 6936
333b20bb 6937 bcopy (xbm_format, kw, sizeof kw);
bfd2209f 6938 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
333b20bb
GM		 6939 return 0;
6940
6941 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
6942
6943 if (kw[XBM_FILE].count)
6944 {
6945 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
6946 return 0;
6947 }
5be6c3b0
GM		 6948 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
6949 {
6950 /* In-memory XBM file. */
6951 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
6952 return 0;
6953 }
333b20bb
GM		 6954 else
6955 {
6956 Lisp_Object data;
6957 int width, height;
6958
6959 /* Entries for `:width', `:height' and `:data' must be present. */
6960 if (!kw[XBM_WIDTH].count
6961 || !kw[XBM_HEIGHT].count
6962 || !kw[XBM_DATA].count)
6963 return 0;
6964
6965 data = kw[XBM_DATA].value;
6966 width = XFASTINT (kw[XBM_WIDTH].value);
6967 height = XFASTINT (kw[XBM_HEIGHT].value);
488dd4c4 6968
333b20bb
GM		 6969 /* Check type of data, and width and height against contents of
6970 data. */
6971 if (VECTORP (data))
6972 {
6973 int i;
488dd4c4 6974
333b20bb
GM		 6975 /* Number of elements of the vector must be >= height. */
6976 if (XVECTOR (data)->size < height)
6977 return 0;
6978
6979 /* Each string or bool-vector in data must be large enough
6980 for one line of the image. */
6981 for (i = 0; i < height; ++i)
6982 {
6983 Lisp_Object elt = XVECTOR (data)->contents[i];
6984
6985 if (STRINGP (elt))
6986 {
d5db4077 6987 if (SCHARS (elt)
333b20bb
GM		 6988 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6989 return 0;
6990 }
6991 else if (BOOL_VECTOR_P (elt))
6992 {
6993 if (XBOOL_VECTOR (elt)->size < width)
6994 return 0;
6995 }
6996 else
6997 return 0;
6998 }
6999 }
7000 else if (STRINGP (data))
7001 {
d5db4077 7002 if (SCHARS (data)
333b20bb
GM		 7003 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
7004 return 0;
7005 }
7006 else if (BOOL_VECTOR_P (data))
7007 {
7008 if (XBOOL_VECTOR (data)->size < width * height)
7009 return 0;
7010 }
7011 else
7012 return 0;
7013 }
7014
333b20bb
GM		 7015 return 1;
7016}
7017
7018
7019/* Scan a bitmap file. FP is the stream to read from. Value is
7020 either an enumerator from enum xbm_token, or a character for a
7021 single-character token, or 0 at end of file. If scanning an
7022 identifier, store the lexeme of the identifier in SVAL. If
7023 scanning a number, store its value in *IVAL. */
7024
7025static int
5be6c3b0
GM		 7026xbm_scan (s, end, sval, ival)
7027 char **s, *end;
333b20bb
GM		 7028 char *sval;
7029 int *ival;
7030{
7031 int c;
0a695da7
GM		 7032
7033 loop:
488dd4c4 7034
333b20bb 7035 /* Skip white space. */
5be6c3b0 7036 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM		 7037 ;
7038
5be6c3b0 7039 if (*s >= end)
333b20bb
GM		 7040 c = 0;
7041 else if (isdigit (c))
7042 {
7043 int value = 0, digit;
488dd4c4 7044
5be6c3b0 7045 if (c == '0' && *s < end)
333b20bb 7046 {
5be6c3b0 7047 c = *(*s)++;
333b20bb
GM		 7048 if (c == 'x' || c == 'X')
7049 {
5be6c3b0 7050 while (*s < end)
333b20bb 7051 {
5be6c3b0 7052 c = *(*s)++;
333b20bb
GM		 7053 if (isdigit (c))
7054 digit = c - '0';
7055 else if (c >= 'a' && c <= 'f')
7056 digit = c - 'a' + 10;
7057 else if (c >= 'A' && c <= 'F')
7058 digit = c - 'A' + 10;
7059 else
7060 break;
7061 value = 16 * value + digit;
7062 }
7063 }
7064 else if (isdigit (c))
7065 {
7066 value = c - '0';
5be6c3b0
GM		 7067 while (*s < end
7068 && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 7069 value = 8 * value + c - '0';
7070 }
7071 }
7072 else
7073 {
7074 value = c - '0';
5be6c3b0
GM		 7075 while (*s < end
7076 && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 7077 value = 10 * value + c - '0';
7078 }
7079
5be6c3b0
GM		 7080 if (*s < end)
7081 *s = *s - 1;
333b20bb
GM		 7082 *ival = value;
7083 c = XBM_TK_NUMBER;
7084 }
7085 else if (isalpha (c) || c == '_')
7086 {
7087 *sval++ = c;
5be6c3b0
GM		 7088 while (*s < end
7089 && (c = *(*s)++, (isalnum (c) || c == '_')))
333b20bb
GM		 7090 *sval++ = c;
7091 *sval = 0;
5be6c3b0
GM		 7092 if (*s < end)
7093 *s = *s - 1;
333b20bb
GM		 7094 c = XBM_TK_IDENT;
7095 }
0a695da7
GM		 7096 else if (c == '/' && **s == '*')
7097 {
7098 /* C-style comment. */
7099 ++*s;
7100 while (**s && (**s != '*' || *(*s + 1) != '/'))
7101 ++*s;
7102 if (**s)
7103 {
7104 *s += 2;
7105 goto loop;
7106 }
7107 }
333b20bb
GM		 7108
7109 return c;
7110}
7111
7112
7113/* Replacement for XReadBitmapFileData which isn't available under old
5be6c3b0
GM		 7114 X versions. CONTENTS is a pointer to a buffer to parse; END is the
7115 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
7116 the image. Return in *DATA the bitmap data allocated with xmalloc.
7117 Value is non-zero if successful. DATA null means just test if
b243755a 7118 CONTENTS looks like an in-memory XBM file. */
333b20bb
GM		 7119
7120static int
5be6c3b0
GM		 7121xbm_read_bitmap_data (contents, end, width, height, data)
7122 char *contents, *end;
333b20bb
GM		 7123 int *width, *height;
7124 unsigned char **data;
7125{
5be6c3b0 7126 char *s = contents;
333b20bb
GM		 7127 char buffer[BUFSIZ];
7128 int padding_p = 0;
7129 int v10 = 0;
7130 int bytes_per_line, i, nbytes;
7131 unsigned char *p;
7132 int value;
7133 int LA1;
7134
7135#define match() \
5be6c3b0 7136 LA1 = xbm_scan (&s, end, buffer, &value)
333b20bb
GM		 7137
7138#define expect(TOKEN) \
7139 if (LA1 != (TOKEN)) \
7140 goto failure; \
7141 else \
488dd4c4 7142 match ()
333b20bb
GM		 7143
7144#define expect_ident(IDENT) \
7145 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
7146 match (); \
7147 else \
7148 goto failure
7149
333b20bb 7150 *width = *height = -1;
5be6c3b0
GM		 7151 if (data)
7152 *data = NULL;
7153 LA1 = xbm_scan (&s, end, buffer, &value);
333b20bb
GM		 7154
7155 /* Parse defines for width, height and hot-spots. */
7156 while (LA1 == '#')
7157 {
333b20bb
GM		 7158 match ();
7159 expect_ident ("define");
7160 expect (XBM_TK_IDENT);
7161
7162 if (LA1 == XBM_TK_NUMBER);
7163 {
7164 char *p = strrchr (buffer, '_');
7165 p = p ? p + 1 : buffer;
7166 if (strcmp (p, "width") == 0)
7167 *width = value;
7168 else if (strcmp (p, "height") == 0)
7169 *height = value;
7170 }
7171 expect (XBM_TK_NUMBER);
7172 }
7173
7174 if (*width < 0 || *height < 0)
7175 goto failure;
5be6c3b0
GM		 7176 else if (data == NULL)
7177 goto success;
333b20bb
GM		 7178
7179 /* Parse bits. Must start with `static'. */
7180 expect_ident ("static");
7181 if (LA1 == XBM_TK_IDENT)
7182 {
7183 if (strcmp (buffer, "unsigned") == 0)
7184 {
488dd4c4 7185 match ();
333b20bb
GM		 7186 expect_ident ("char");
7187 }
7188 else if (strcmp (buffer, "short") == 0)
7189 {
7190 match ();
7191 v10 = 1;
7192 if (*width % 16 && *width % 16 < 9)
7193 padding_p = 1;
7194 }
7195 else if (strcmp (buffer, "char") == 0)
7196 match ();
7197 else
7198 goto failure;
7199 }
488dd4c4 7200 else
333b20bb
GM		 7201 goto failure;
7202
7203 expect (XBM_TK_IDENT);
7204 expect ('[');
7205 expect (']');
7206 expect ('=');
7207 expect ('{');
7208
7209 bytes_per_line = (*width + 7) / 8 + padding_p;
7210 nbytes = bytes_per_line * *height;
7211 p = *data = (char *) xmalloc (nbytes);
7212
7213 if (v10)
7214 {
333b20bb
GM		 7215 for (i = 0; i < nbytes; i += 2)
7216 {
7217 int val = value;
7218 expect (XBM_TK_NUMBER);
7219
7220 *p++ = val;
7221 if (!padding_p || ((i + 2) % bytes_per_line))
7222 *p++ = value >> 8;
488dd4c4 7223
333b20bb
GM		 7224 if (LA1 == ',' || LA1 == '}')
7225 match ();
7226 else
7227 goto failure;
7228 }
7229 }
7230 else
7231 {
7232 for (i = 0; i < nbytes; ++i)
7233 {
7234 int val = value;
7235 expect (XBM_TK_NUMBER);
488dd4c4 7236
333b20bb 7237 *p++ = val;
488dd4c4 7238
333b20bb
GM		 7239 if (LA1 == ',' || LA1 == '}')
7240 match ();
7241 else
7242 goto failure;
7243 }
7244 }
7245
5be6c3b0 7246 success:
333b20bb
GM		 7247 return 1;
7248
7249 failure:
488dd4c4 7250
5be6c3b0 7251 if (data && *data)
333b20bb
GM		 7252 {
7253 xfree (*data);
7254 *data = NULL;
7255 }
7256 return 0;
7257
7258#undef match
7259#undef expect
7260#undef expect_ident
7261}
7262
7263
5be6c3b0
GM		 7264/* Load XBM image IMG which will be displayed on frame F from buffer
7265 CONTENTS. END is the end of the buffer. Value is non-zero if
7266 successful. */
333b20bb
GM		 7267
7268static int
5be6c3b0 7269xbm_load_image (f, img, contents, end)
333b20bb
GM		 7270 struct frame *f;
7271 struct image *img;
5be6c3b0 7272 char *contents, *end;
333b20bb
GM		 7273{
7274 int rc;
7275 unsigned char *data;
7276 int success_p = 0;
488dd4c4 7277
5be6c3b0 7278 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
333b20bb
GM		 7279 if (rc)
7280 {
7281 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7282 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
7283 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
7284 Lisp_Object value;
488dd4c4 7285
333b20bb
GM		 7286 xassert (img->width > 0 && img->height > 0);
7287
7288 /* Get foreground and background colors, maybe allocate colors. */
7289 value = image_spec_value (img->spec, QCforeground, NULL);
7290 if (!NILP (value))
7291 foreground = x_alloc_image_color (f, img, value, foreground);
333b20bb
GM		 7292 value = image_spec_value (img->spec, QCbackground, NULL);
7293 if (!NILP (value))
f20a3b7a
MB		 7294 {
7295 background = x_alloc_image_color (f, img, value, background);
7296 img->background = background;
7297 img->background_valid = 1;
7298 }
333b20bb 7299
333b20bb
GM		 7300 img->pixmap
7301 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7302 FRAME_X_WINDOW (f),
7303 data,
7304 img->width, img->height,
7305 foreground, background,
7306 depth);
7307 xfree (data);
7308
dd00328a 7309 if (img->pixmap == None)
333b20bb
GM		 7310 {
7311 x_clear_image (f, img);
5be6c3b0 7312 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
333b20bb
GM		 7313 }
7314 else
7315 success_p = 1;
333b20bb
GM		 7316 }
7317 else
45158a91 7318 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
333b20bb 7319
333b20bb
GM		 7320 return success_p;
7321}
7322
7323
5be6c3b0
GM		 7324/* Value is non-zero if DATA looks like an in-memory XBM file. */
7325
7326static int
7327xbm_file_p (data)
7328 Lisp_Object data;
7329{
7330 int w, h;
7331 return (STRINGP (data)
d5db4077
KR		 7332 && xbm_read_bitmap_data (SDATA (data),
7333 (SDATA (data)
7334 + SBYTES (data)),
5be6c3b0
GM		 7335 &w, &h, NULL));
7336}
7337
488dd4c4 7338
333b20bb
GM		 7339/* Fill image IMG which is used on frame F with pixmap data. Value is
7340 non-zero if successful. */
7341
7342static int
7343xbm_load (f, img)
7344 struct frame *f;
7345 struct image *img;
7346{
7347 int success_p = 0;
7348 Lisp_Object file_name;
7349
7350 xassert (xbm_image_p (img->spec));
7351
7352 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7353 file_name = image_spec_value (img->spec, QCfile, NULL);
7354 if (STRINGP (file_name))
5be6c3b0
GM		 7355 {
7356 Lisp_Object file;
7357 char *contents;
7358 int size;
7359 struct gcpro gcpro1;
488dd4c4 7360
5be6c3b0
GM		 7361 file = x_find_image_file (file_name);
7362 GCPRO1 (file);
7363 if (!STRINGP (file))
7364 {
7365 image_error ("Cannot find image file `%s'", file_name, Qnil);
7366 UNGCPRO;
7367 return 0;
7368 }
7369
d5db4077 7370 contents = slurp_file (SDATA (file), &size);
5be6c3b0
GM		 7371 if (contents == NULL)
7372 {
7373 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
7374 UNGCPRO;
7375 return 0;
7376 }
7377
7378 success_p = xbm_load_image (f, img, contents, contents + size);
7379 UNGCPRO;
7380 }
333b20bb
GM		 7381 else
7382 {
7383 struct image_keyword fmt[XBM_LAST];
7384 Lisp_Object data;
7385 int depth;
7386 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
7387 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
7388 char *bits;
9b207e8e 7389 int parsed_p;
5be6c3b0
GM		 7390 int in_memory_file_p = 0;
7391
7392 /* See if data looks like an in-memory XBM file. */
7393 data = image_spec_value (img->spec, QCdata, NULL);
7394 in_memory_file_p = xbm_file_p (data);
333b20bb 7395
5be6c3b0 7396 /* Parse the image specification. */
333b20bb 7397 bcopy (xbm_format, fmt, sizeof fmt);
bfd2209f 7398 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
333b20bb
GM		 7399 xassert (parsed_p);
7400
7401 /* Get specified width, and height. */
5be6c3b0
GM		 7402 if (!in_memory_file_p)
7403 {
7404 img->width = XFASTINT (fmt[XBM_WIDTH].value);
7405 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
7406 xassert (img->width > 0 && img->height > 0);
7407 }
333b20bb 7408
333b20bb 7409 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM		 7410 if (fmt[XBM_FOREGROUND].count
7411 && STRINGP (fmt[XBM_FOREGROUND].value))
333b20bb
GM		 7412 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
7413 foreground);
6f1be3b9
GM		 7414 if (fmt[XBM_BACKGROUND].count
7415 && STRINGP (fmt[XBM_BACKGROUND].value))
333b20bb
GM		 7416 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
7417 background);
7418
5be6c3b0 7419 if (in_memory_file_p)
d5db4077
KR		 7420 success_p = xbm_load_image (f, img, SDATA (data),
7421 (SDATA (data)
7422 + SBYTES (data)));
5be6c3b0 7423 else
333b20bb 7424 {
5be6c3b0
GM		 7425 if (VECTORP (data))
7426 {
7427 int i;
7428 char *p;
7429 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
488dd4c4 7430
5be6c3b0
GM		 7431 p = bits = (char *) alloca (nbytes * img->height);
7432 for (i = 0; i < img->height; ++i, p += nbytes)
7433 {
7434 Lisp_Object line = XVECTOR (data)->contents[i];
7435 if (STRINGP (line))
d5db4077 7436 bcopy (SDATA (line), p, nbytes);
5be6c3b0
GM		 7437 else
7438 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
7439 }
7440 }
7441 else if (STRINGP (data))
d5db4077 7442 bits = SDATA (data);
5be6c3b0
GM		 7443 else
7444 bits = XBOOL_VECTOR (data)->data;
7445
7446 /* Create the pixmap. */
7447 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7448 img->pixmap
7449 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7450 FRAME_X_WINDOW (f),
7451 bits,
7452 img->width, img->height,
7453 foreground, background,
7454 depth);
7455 if (img->pixmap)
7456 success_p = 1;
7457 else
333b20bb 7458 {
5be6c3b0
GM		 7459 image_error ("Unable to create pixmap for XBM image `%s'",
7460 img->spec, Qnil);
7461 x_clear_image (f, img);
333b20bb
GM		 7462 }
7463 }
333b20bb
GM		 7464 }
7465
7466 return success_p;
7467}
488dd4c4 7468
333b20bb
GM		 7469
7470\f
7471/***********************************************************************
7472 XPM images
7473 ***********************************************************************/
7474
488dd4c4 7475#if HAVE_XPM
333b20bb
GM		 7476
7477static int xpm_image_p P_ ((Lisp_Object object));
7478static int xpm_load P_ ((struct frame *f, struct image *img));
7479static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
7480
7481#include "X11/xpm.h"
7482
7483/* The symbol `xpm' identifying XPM-format images. */
7484
7485Lisp_Object Qxpm;
7486
7487/* Indices of image specification fields in xpm_format, below. */
7488
7489enum xpm_keyword_index
7490{
7491 XPM_TYPE,
7492 XPM_FILE,
7493 XPM_DATA,
7494 XPM_ASCENT,
7495 XPM_MARGIN,
7496 XPM_RELIEF,
7497 XPM_ALGORITHM,
7498 XPM_HEURISTIC_MASK,
4a8e312c 7499 XPM_MASK,
333b20bb 7500 XPM_COLOR_SYMBOLS,
f20a3b7a 7501 XPM_BACKGROUND,
333b20bb
GM		 7502 XPM_LAST
7503};
7504
7505/* Vector of image_keyword structures describing the format
7506 of valid XPM image specifications. */
7507
7508static struct image_keyword xpm_format[XPM_LAST] =
7509{
7510 {":type", IMAGE_SYMBOL_VALUE, 1},
7511 {":file", IMAGE_STRING_VALUE, 0},
7512 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 7513 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 7514 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 7515 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 7516 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 7517 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 7518 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 7519 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7520 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 7521};
7522
7523/* Structure describing the image type XBM. */
7524
7525static struct image_type xpm_type =
7526{
7527 &Qxpm,
7528 xpm_image_p,
7529 xpm_load,
7530 x_clear_image,
7531 NULL
7532};
7533
7534
b243755a
GM		 7535/* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7536 functions for allocating image colors. Our own functions handle
7537 color allocation failures more gracefully than the ones on the XPM
7538 lib. */
7539
7540#if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7541#define ALLOC_XPM_COLORS
7542#endif
7543
7544#ifdef ALLOC_XPM_COLORS
7545
f72c62ad 7546static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
b243755a
GM		 7547static void xpm_free_color_cache P_ ((void));
7548static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
f72c62ad
GM		 7549static int xpm_color_bucket P_ ((char *));
7550static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
7551 XColor *, int));
b243755a
GM		 7552
7553/* An entry in a hash table used to cache color definitions of named
7554 colors. This cache is necessary to speed up XPM image loading in
7555 case we do color allocations ourselves. Without it, we would need
7556 a call to XParseColor per pixel in the image. */
7557
7558struct xpm_cached_color
7559{
7560 /* Next in collision chain. */
7561 struct xpm_cached_color *next;
7562
7563 /* Color definition (RGB and pixel color). */
7564 XColor color;
7565
7566 /* Color name. */
7567 char name[1];
7568};
7569
7570/* The hash table used for the color cache, and its bucket vector
7571 size. */
7572
7573#define XPM_COLOR_CACHE_BUCKETS 1001
7574struct xpm_cached_color **xpm_color_cache;
7575
b243755a
GM		 7576/* Initialize the color cache. */
7577
7578static void
f72c62ad
GM		 7579xpm_init_color_cache (f, attrs)
7580 struct frame *f;
7581 XpmAttributes *attrs;
b243755a
GM		 7582{
7583 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
7584 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
7585 memset (xpm_color_cache, 0, nbytes);
7586 init_color_table ();
f72c62ad
GM		 7587
7588 if (attrs->valuemask & XpmColorSymbols)
7589 {
7590 int i;
7591 XColor color;
488dd4c4 7592
f72c62ad
GM		 7593 for (i = 0; i < attrs->numsymbols; ++i)
7594 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7595 attrs->colorsymbols[i].value, &color))
7596 {
7597 color.pixel = lookup_rgb_color (f, color.red, color.green,
7598 color.blue);
7599 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
7600 }
7601 }
b243755a
GM		 7602}
7603
7604
7605/* Free the color cache. */
7606
7607static void
7608xpm_free_color_cache ()
7609{
7610 struct xpm_cached_color *p, *next;
7611 int i;
7612
7613 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
7614 for (p = xpm_color_cache[i]; p; p = next)
7615 {
7616 next = p->next;
7617 xfree (p);
7618 }
7619
7620 xfree (xpm_color_cache);
7621 xpm_color_cache = NULL;
7622 free_color_table ();
7623}
7624
7625
f72c62ad
GM		 7626/* Return the bucket index for color named COLOR_NAME in the color
7627 cache. */
7628
7629static int
7630xpm_color_bucket (color_name)
7631 char *color_name;
7632{
7633 unsigned h = 0;
7634 char *s;
488dd4c4 7635
f72c62ad
GM		 7636 for (s = color_name; *s; ++s)
7637 h = (h << 2) ^ *s;
7638 return h %= XPM_COLOR_CACHE_BUCKETS;
7639}
7640
7641
7642/* On frame F, cache values COLOR for color with name COLOR_NAME.
7643 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7644 entry added. */
7645
7646static struct xpm_cached_color *
7647xpm_cache_color (f, color_name, color, bucket)
7648 struct frame *f;
7649 char *color_name;
7650 XColor *color;
7651 int bucket;
7652{
7653 size_t nbytes;
7654 struct xpm_cached_color *p;
488dd4c4 7655
f72c62ad
GM		 7656 if (bucket < 0)
7657 bucket = xpm_color_bucket (color_name);
488dd4c4 7658
f72c62ad
GM		 7659 nbytes = sizeof *p + strlen (color_name);
7660 p = (struct xpm_cached_color *) xmalloc (nbytes);
7661 strcpy (p->name, color_name);
7662 p->color = *color;
7663 p->next = xpm_color_cache[bucket];
7664 xpm_color_cache[bucket] = p;
7665 return p;
7666}
7667
7668
b243755a
GM		 7669/* Look up color COLOR_NAME for frame F in the color cache. If found,
7670 return the cached definition in *COLOR. Otherwise, make a new
7671 entry in the cache and allocate the color. Value is zero if color
7672 allocation failed. */
7673
7674static int
7675xpm_lookup_color (f, color_name, color)
7676 struct frame *f;
7677 char *color_name;
7678 XColor *color;
7679{
b243755a 7680 struct xpm_cached_color *p;
83676598 7681 int h = xpm_color_bucket (color_name);
b243755a
GM		 7682
7683 for (p = xpm_color_cache[h]; p; p = p->next)
7684 if (strcmp (p->name, color_name) == 0)
7685 break;
7686
7687 if (p != NULL)
7688 *color = p->color;
7689 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7690 color_name, color))
7691 {
b243755a
GM		 7692 color->pixel = lookup_rgb_color (f, color->red, color->green,
7693 color->blue);
f72c62ad 7694 p = xpm_cache_color (f, color_name, color, h);
b243755a 7695 }
488dd4c4 7696
b243755a
GM		 7697 return p != NULL;
7698}
7699
7700
7701/* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7702 CLOSURE is a pointer to the frame on which we allocate the
7703 color. Return in *COLOR the allocated color. Value is non-zero
7704 if successful. */
7705
7706static int
7707xpm_alloc_color (dpy, cmap, color_name, color, closure)
7708 Display *dpy;
7709 Colormap cmap;
7710 char *color_name;
7711 XColor *color;
7712 void *closure;
7713{
7714 return xpm_lookup_color ((struct frame *) closure, color_name, color);
7715}
7716
7717
7718/* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7719 is a pointer to the frame on which we allocate the color. Value is
7720 non-zero if successful. */
7721
7722static int
7723xpm_free_colors (dpy, cmap, pixels, npixels, closure)
7724 Display *dpy;
7725 Colormap cmap;
7726 Pixel *pixels;
7727 int npixels;
7728 void *closure;
7729{
7730 return 1;
7731}
7732
7733#endif /* ALLOC_XPM_COLORS */
7734
7735
333b20bb
GM		 7736/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7737 for XPM images. Such a list must consist of conses whose car and
7738 cdr are strings. */
7739
7740static int
7741xpm_valid_color_symbols_p (color_symbols)
7742 Lisp_Object color_symbols;
7743{
7744 while (CONSP (color_symbols))
7745 {
7746 Lisp_Object sym = XCAR (color_symbols);
7747 if (!CONSP (sym)
7748 || !STRINGP (XCAR (sym))
7749 || !STRINGP (XCDR (sym)))
7750 break;
7751 color_symbols = XCDR (color_symbols);
7752 }
7753
7754 return NILP (color_symbols);
7755}
7756
7757
7758/* Value is non-zero if OBJECT is a valid XPM image specification. */
7759
7760static int
7761xpm_image_p (object)
7762 Lisp_Object object;
7763{
7764 struct image_keyword fmt[XPM_LAST];
7765 bcopy (xpm_format, fmt, sizeof fmt);
bfd2209f 7766 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
333b20bb
GM		 7767 /* Either `:file' or `:data' must be present. */
7768 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
7769 /* Either no `:color-symbols' or it's a list of conses
7770 whose car and cdr are strings. */
7771 && (fmt[XPM_COLOR_SYMBOLS].count == 0
7c7ff7f5 7772 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
333b20bb
GM		 7773}
7774
7775
7776/* Load image IMG which will be displayed on frame F. Value is
7777 non-zero if successful. */
7778
7779static int
7780xpm_load (f, img)
7781 struct frame *f;
7782 struct image *img;
7783{
9b207e8e 7784 int rc;
333b20bb
GM		 7785 XpmAttributes attrs;
7786 Lisp_Object specified_file, color_symbols;
7787
7788 /* Configure the XPM lib. Use the visual of frame F. Allocate
7789 close colors. Return colors allocated. */
7790 bzero (&attrs, sizeof attrs);
9b2956e2
GM		 7791 attrs.visual = FRAME_X_VISUAL (f);
7792 attrs.colormap = FRAME_X_COLORMAP (f);
333b20bb 7793 attrs.valuemask |= XpmVisual;
9b2956e2 7794 attrs.valuemask |= XpmColormap;
b243755a
GM		 7795
7796#ifdef ALLOC_XPM_COLORS
7797 /* Allocate colors with our own functions which handle
7798 failing color allocation more gracefully. */
7799 attrs.color_closure = f;
7800 attrs.alloc_color = xpm_alloc_color;
7801 attrs.free_colors = xpm_free_colors;
7802 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
7803#else /* not ALLOC_XPM_COLORS */
7804 /* Let the XPM lib allocate colors. */
333b20bb 7805 attrs.valuemask |= XpmReturnAllocPixels;
e4c082be 7806#ifdef XpmAllocCloseColors
333b20bb
GM		 7807 attrs.alloc_close_colors = 1;
7808 attrs.valuemask |= XpmAllocCloseColors;
b243755a 7809#else /* not XpmAllocCloseColors */
e4c082be
RS		 7810 attrs.closeness = 600;
7811 attrs.valuemask |= XpmCloseness;
b243755a
GM		 7812#endif /* not XpmAllocCloseColors */
7813#endif /* ALLOC_XPM_COLORS */
333b20bb
GM		 7814
7815 /* If image specification contains symbolic color definitions, add
7816 these to `attrs'. */
7817 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
7818 if (CONSP (color_symbols))
7819 {
7820 Lisp_Object tail;
7821 XpmColorSymbol *xpm_syms;
7822 int i, size;
488dd4c4 7823
333b20bb
GM		 7824 attrs.valuemask |= XpmColorSymbols;
7825
7826 /* Count number of symbols. */
7827 attrs.numsymbols = 0;
7828 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
7829 ++attrs.numsymbols;
7830
7831 /* Allocate an XpmColorSymbol array. */
7832 size = attrs.numsymbols * sizeof *xpm_syms;
7833 xpm_syms = (XpmColorSymbol *) alloca (size);
7834 bzero (xpm_syms, size);
7835 attrs.colorsymbols = xpm_syms;
7836
7837 /* Fill the color symbol array. */
7838 for (tail = color_symbols, i = 0;
7839 CONSP (tail);
7840 ++i, tail = XCDR (tail))
7841 {
7842 Lisp_Object name = XCAR (XCAR (tail));
7843 Lisp_Object color = XCDR (XCAR (tail));
d5db4077
KR		 7844 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
7845 strcpy (xpm_syms[i].name, SDATA (name));
7846 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
7847 strcpy (xpm_syms[i].value, SDATA (color));
333b20bb
GM		 7848 }
7849 }
7850
7851 /* Create a pixmap for the image, either from a file, or from a
7852 string buffer containing data in the same format as an XPM file. */
b243755a 7853#ifdef ALLOC_XPM_COLORS
f72c62ad 7854 xpm_init_color_cache (f, &attrs);
b243755a 7855#endif
488dd4c4 7856
333b20bb
GM		 7857 specified_file = image_spec_value (img->spec, QCfile, NULL);
7858 if (STRINGP (specified_file))
7859 {
7860 Lisp_Object file = x_find_image_file (specified_file);
7861 if (!STRINGP (file))
7862 {
45158a91 7863 image_error ("Cannot find image file `%s'", specified_file, Qnil);
333b20bb
GM		 7864 return 0;
7865 }
488dd4c4 7866
333b20bb 7867 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
d5db4077 7868 SDATA (file), &img->pixmap, &img->mask,
333b20bb
GM		 7869 &attrs);
7870 }
7871 else
7872 {
7873 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
7874 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
d5db4077 7875 SDATA (buffer),
333b20bb
GM		 7876 &img->pixmap, &img->mask,
7877 &attrs);
7878 }
333b20bb
GM		 7879
7880 if (rc == XpmSuccess)
7881 {
b243755a
GM		 7882#ifdef ALLOC_XPM_COLORS
7883 img->colors = colors_in_color_table (&img->ncolors);
7884#else /* not ALLOC_XPM_COLORS */
f47a9ec4
KR		 7885 int i;
7886
333b20bb
GM		 7887 img->ncolors = attrs.nalloc_pixels;
7888 img->colors = (unsigned long *) xmalloc (img->ncolors
7889 * sizeof *img->colors);
7890 for (i = 0; i < attrs.nalloc_pixels; ++i)
3b4ae1cc
GM		 7891 {
7892 img->colors[i] = attrs.alloc_pixels[i];
7893#ifdef DEBUG_X_COLORS
7894 register_color (img->colors[i]);
7895#endif
7896 }
b243755a 7897#endif /* not ALLOC_XPM_COLORS */
333b20bb
GM		 7898
7899 img->width = attrs.width;
7900 img->height = attrs.height;
7901 xassert (img->width > 0 && img->height > 0);
7902
7903 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
333b20bb 7904 XpmFreeAttributes (&attrs);
333b20bb
GM		 7905 }
7906 else
7907 {
7908 switch (rc)
7909 {
7910 case XpmOpenFailed:
7911 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
7912 break;
488dd4c4 7913
333b20bb
GM		 7914 case XpmFileInvalid:
7915 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
7916 break;
488dd4c4 7917
333b20bb
GM		 7918 case XpmNoMemory:
7919 image_error ("Out of memory (%s)", img->spec, Qnil);
7920 break;
488dd4c4 7921
333b20bb
GM		 7922 case XpmColorFailed:
7923 image_error ("Color allocation error (%s)", img->spec, Qnil);
7924 break;
488dd4c4 7925
333b20bb
GM		 7926 default:
7927 image_error ("Unknown error (%s)", img->spec, Qnil);
7928 break;
7929 }
7930 }
7931
b243755a
GM		 7932#ifdef ALLOC_XPM_COLORS
7933 xpm_free_color_cache ();
7934#endif
333b20bb
GM		 7935 return rc == XpmSuccess;
7936}
7937
7938#endif /* HAVE_XPM != 0 */
7939
7940\f
7941/***********************************************************************
7942 Color table
7943 ***********************************************************************/
7944
7945/* An entry in the color table mapping an RGB color to a pixel color. */
7946
7947struct ct_color
7948{
7949 int r, g, b;
7950 unsigned long pixel;
7951
7952 /* Next in color table collision list. */
7953 struct ct_color *next;
7954};
7955
7956/* The bucket vector size to use. Must be prime. */
7957
7958#define CT_SIZE 101
7959
7960/* Value is a hash of the RGB color given by R, G, and B. */
7961
7962#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7963
7964/* The color hash table. */
7965
7966struct ct_color **ct_table;
7967
7968/* Number of entries in the color table. */
7969
7970int ct_colors_allocated;
7971
333b20bb
GM		 7972/* Initialize the color table. */
7973
7974static void
7975init_color_table ()
7976{
7977 int size = CT_SIZE * sizeof (*ct_table);
7978 ct_table = (struct ct_color **) xmalloc (size);
7979 bzero (ct_table, size);
7980 ct_colors_allocated = 0;
7981}
7982
7983
7984/* Free memory associated with the color table. */
7985
7986static void
7987free_color_table ()
7988{
7989 int i;
7990 struct ct_color *p, *next;
7991
7992 for (i = 0; i < CT_SIZE; ++i)
7993 for (p = ct_table[i]; p; p = next)
7994 {
7995 next = p->next;
7996 xfree (p);
7997 }
7998
7999 xfree (ct_table);
8000 ct_table = NULL;
8001}
8002
8003
8004/* Value is a pixel color for RGB color R, G, B on frame F. If an
8005 entry for that color already is in the color table, return the
8006 pixel color of that entry. Otherwise, allocate a new color for R,
8007 G, B, and make an entry in the color table. */
8008
8009static unsigned long
8010lookup_rgb_color (f, r, g, b)
8011 struct frame *f;
8012 int r, g, b;
8013{
8014 unsigned hash = CT_HASH_RGB (r, g, b);
8015 int i = hash % CT_SIZE;
8016 struct ct_color *p;
8017
8018 for (p = ct_table[i]; p; p = p->next)
8019 if (p->r == r && p->g == g && p->b == b)
8020 break;
8021
8022 if (p == NULL)
8023 {
8024 XColor color;
8025 Colormap cmap;
8026 int rc;
8027
8028 color.red = r;
8029 color.green = g;
8030 color.blue = b;
488dd4c4 8031
9b2956e2 8032 cmap = FRAME_X_COLORMAP (f);
d62c8769 8033 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM		 8034
8035 if (rc)
8036 {
8037 ++ct_colors_allocated;
488dd4c4 8038
333b20bb
GM		 8039 p = (struct ct_color *) xmalloc (sizeof *p);
8040 p->r = r;
8041 p->g = g;
8042 p->b = b;
8043 p->pixel = color.pixel;
8044 p->next = ct_table[i];
8045 ct_table[i] = p;
8046 }
8047 else
8048 return FRAME_FOREGROUND_PIXEL (f);
8049 }
8050
8051 return p->pixel;
8052}
8053
8054
8055/* Look up pixel color PIXEL which is used on frame F in the color
8056 table. If not already present, allocate it. Value is PIXEL. */
8057
8058static unsigned long
8059lookup_pixel_color (f, pixel)
8060 struct frame *f;
8061 unsigned long pixel;
8062{
8063 int i = pixel % CT_SIZE;
8064 struct ct_color *p;
8065
8066 for (p = ct_table[i]; p; p = p->next)
8067 if (p->pixel == pixel)
8068 break;
8069
8070 if (p == NULL)
8071 {
8072 XColor color;
8073 Colormap cmap;
8074 int rc;
8075
9b2956e2 8076 cmap = FRAME_X_COLORMAP (f);
333b20bb 8077 color.pixel = pixel;
a31fedb7 8078 x_query_color (f, &color);
d62c8769 8079 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM		 8080
8081 if (rc)
8082 {
8083 ++ct_colors_allocated;
488dd4c4 8084
333b20bb
GM		 8085 p = (struct ct_color *) xmalloc (sizeof *p);
8086 p->r = color.red;
8087 p->g = color.green;
8088 p->b = color.blue;
8089 p->pixel = pixel;
8090 p->next = ct_table[i];
8091 ct_table[i] = p;
8092 }
8093 else
8094 return FRAME_FOREGROUND_PIXEL (f);
8095 }
488dd4c4 8096
333b20bb
GM		 8097 return p->pixel;
8098}
8099
8100
8101/* Value is a vector of all pixel colors contained in the color table,
8102 allocated via xmalloc. Set *N to the number of colors. */
8103
8104static unsigned long *
8105colors_in_color_table (n)
8106 int *n;
8107{
8108 int i, j;
8109 struct ct_color *p;
8110 unsigned long *colors;
8111
8112 if (ct_colors_allocated == 0)
8113 {
8114 *n = 0;
8115 colors = NULL;
8116 }
8117 else
8118 {
8119 colors = (unsigned long *) xmalloc (ct_colors_allocated
8120 * sizeof *colors);
8121 *n = ct_colors_allocated;
488dd4c4 8122
333b20bb
GM		 8123 for (i = j = 0; i < CT_SIZE; ++i)
8124 for (p = ct_table[i]; p; p = p->next)
8125 colors[j++] = p->pixel;
8126 }
8127
8128 return colors;
8129}
8130
8131
8132\f
8133/***********************************************************************
8134 Algorithms
8135 ***********************************************************************/
8136
4a8e312c
GM		 8137static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
8138static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
8139static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
8140
d2dc8167 8141/* Non-zero means draw a cross on images having `:conversion
14819cb3
GM		 8142 disabled'. */
8143
8144int cross_disabled_images;
8145
4a8e312c
GM		 8146/* Edge detection matrices for different edge-detection
8147 strategies. */
8148
8149static int emboss_matrix[9] = {
8150 /* x - 1 x x + 1 */
8151 2, -1, 0, /* y - 1 */
8152 -1, 0, 1, /* y */
8153 0, 1, -2 /* y + 1 */
8154};
333b20bb 8155
4a8e312c
GM		 8156static int laplace_matrix[9] = {
8157 /* x - 1 x x + 1 */
8158 1, 0, 0, /* y - 1 */
8159 0, 0, 0, /* y */
8160 0, 0, -1 /* y + 1 */
8161};
333b20bb 8162
14819cb3
GM		 8163/* Value is the intensity of the color whose red/green/blue values
8164 are R, G, and B. */
8165
8166#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
8167
333b20bb 8168
4a8e312c
GM		 8169/* On frame F, return an array of XColor structures describing image
8170 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
8171 non-zero means also fill the red/green/blue members of the XColor
8172 structures. Value is a pointer to the array of XColors structures,
8173 allocated with xmalloc; it must be freed by the caller. */
8174
8175static XColor *
8176x_to_xcolors (f, img, rgb_p)
333b20bb 8177 struct frame *f;
4a8e312c
GM		 8178 struct image *img;
8179 int rgb_p;
333b20bb 8180{
4a8e312c
GM		 8181 int x, y;
8182 XColor *colors, *p;
8183 XImage *ximg;
333b20bb 8184
4a8e312c
GM		 8185 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
8186
8187 /* Get the X image IMG->pixmap. */
8188 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
8189 0, 0, img->width, img->height, ~0, ZPixmap);
333b20bb 8190
4a8e312c
GM		 8191 /* Fill the `pixel' members of the XColor array. I wished there
8192 were an easy and portable way to circumvent XGetPixel. */
8193 p = colors;
8194 for (y = 0; y < img->height; ++y)
8195 {
8196 XColor *row = p;
488dd4c4 8197
4a8e312c
GM		 8198 for (x = 0; x < img->width; ++x, ++p)
8199 p->pixel = XGetPixel (ximg, x, y);
8200
8201 if (rgb_p)
a31fedb7 8202 x_query_colors (f, row, img->width);
4a8e312c
GM		 8203 }
8204
8205 XDestroyImage (ximg);
4a8e312c 8206 return colors;
333b20bb
GM		 8207}
8208
8209
4a8e312c
GM		 8210/* Create IMG->pixmap from an array COLORS of XColor structures, whose
8211 RGB members are set. F is the frame on which this all happens.
8212 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
333b20bb
GM		 8213
8214static void
4a8e312c 8215x_from_xcolors (f, img, colors)
333b20bb 8216 struct frame *f;
4a8e312c
GM		 8217 struct image *img;
8218 XColor *colors;
333b20bb 8219{
4a8e312c
GM		 8220 int x, y;
8221 XImage *oimg;
8222 Pixmap pixmap;
8223 XColor *p;
488dd4c4 8224
4a8e312c 8225 init_color_table ();
488dd4c4 8226
4a8e312c
GM		 8227 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
8228 &oimg, &pixmap);
8229 p = colors;
8230 for (y = 0; y < img->height; ++y)
8231 for (x = 0; x < img->width; ++x, ++p)
8232 {
8233 unsigned long pixel;
8234 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
8235 XPutPixel (oimg, x, y, pixel);
8236 }
8237
8238 xfree (colors);
dd00328a 8239 x_clear_image_1 (f, img, 1, 0, 1);
4a8e312c
GM		 8240
8241 x_put_x_image (f, oimg, pixmap, img->width, img->height);
8242 x_destroy_x_image (oimg);
8243 img->pixmap = pixmap;
8244 img->colors = colors_in_color_table (&img->ncolors);
8245 free_color_table ();
333b20bb
GM		 8246}
8247
8248
4a8e312c
GM		 8249/* On frame F, perform edge-detection on image IMG.
8250
8251 MATRIX is a nine-element array specifying the transformation
8252 matrix. See emboss_matrix for an example.
488dd4c4 8253
4a8e312c
GM		 8254 COLOR_ADJUST is a color adjustment added to each pixel of the
8255 outgoing image. */
333b20bb
GM		 8256
8257static void
4a8e312c 8258x_detect_edges (f, img, matrix, color_adjust)
333b20bb
GM		 8259 struct frame *f;
8260 struct image *img;
4a8e312c 8261 int matrix[9], color_adjust;
333b20bb 8262{
4a8e312c
GM		 8263 XColor *colors = x_to_xcolors (f, img, 1);
8264 XColor *new, *p;
8265 int x, y, i, sum;
333b20bb 8266
4a8e312c
GM		 8267 for (i = sum = 0; i < 9; ++i)
8268 sum += abs (matrix[i]);
333b20bb 8269
4a8e312c 8270#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
333b20bb 8271
4a8e312c 8272 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
333b20bb 8273
4a8e312c
GM		 8274 for (y = 0; y < img->height; ++y)
8275 {
8276 p = COLOR (new, 0, y);
8277 p->red = p->green = p->blue = 0xffff/2;
8278 p = COLOR (new, img->width - 1, y);
8279 p->red = p->green = p->blue = 0xffff/2;
8280 }
488dd4c4 8281
4a8e312c
GM		 8282 for (x = 1; x < img->width - 1; ++x)
8283 {
8284 p = COLOR (new, x, 0);
8285 p->red = p->green = p->blue = 0xffff/2;
8286 p = COLOR (new, x, img->height - 1);
8287 p->red = p->green = p->blue = 0xffff/2;
8288 }
333b20bb 8289
4a8e312c 8290 for (y = 1; y < img->height - 1; ++y)
333b20bb 8291 {
4a8e312c 8292 p = COLOR (new, 1, y);
488dd4c4 8293
4a8e312c
GM		 8294 for (x = 1; x < img->width - 1; ++x, ++p)
8295 {
14819cb3 8296 int r, g, b, y1, x1;
4a8e312c
GM		 8297
8298 r = g = b = i = 0;
8299 for (y1 = y - 1; y1 < y + 2; ++y1)
8300 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
8301 if (matrix[i])
8302 {
8303 XColor *t = COLOR (colors, x1, y1);
8304 r += matrix[i] * t->red;
8305 g += matrix[i] * t->green;
8306 b += matrix[i] * t->blue;
8307 }
333b20bb 8308
4a8e312c
GM		 8309 r = (r / sum + color_adjust) & 0xffff;
8310 g = (g / sum + color_adjust) & 0xffff;
8311 b = (b / sum + color_adjust) & 0xffff;
14819cb3 8312 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
333b20bb 8313 }
333b20bb
GM		 8314 }
8315
4a8e312c
GM		 8316 xfree (colors);
8317 x_from_xcolors (f, img, new);
333b20bb 8318
4a8e312c
GM		 8319#undef COLOR
8320}
8321
8322
8323/* Perform the pre-defined `emboss' edge-detection on image IMG
8324 on frame F. */
8325
8326static void
8327x_emboss (f, img)
8328 struct frame *f;
8329 struct image *img;
8330{
8331 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
8332}
8333
8334
8335/* Perform the pre-defined `laplace' edge-detection on image IMG
8336 on frame F. */
8337
8338static void
8339x_laplace (f, img)
8340 struct frame *f;
8341 struct image *img;
8342{
8343 x_detect_edges (f, img, laplace_matrix, 45000);
8344}
8345
8346
8347/* Perform edge-detection on image IMG on frame F, with specified
8348 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
8349
8350 MATRIX must be either
8351
8352 - a list of at least 9 numbers in row-major form
8353 - a vector of at least 9 numbers
8354
8355 COLOR_ADJUST nil means use a default; otherwise it must be a
8356 number. */
8357
8358static void
8359x_edge_detection (f, img, matrix, color_adjust)
8360 struct frame *f;
8361 struct image *img;
8362 Lisp_Object matrix, color_adjust;
8363{
8364 int i = 0;
8365 int trans[9];
488dd4c4 8366
4a8e312c
GM		 8367 if (CONSP (matrix))
8368 {
8369 for (i = 0;
8370 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
8371 ++i, matrix = XCDR (matrix))
8372 trans[i] = XFLOATINT (XCAR (matrix));
8373 }
8374 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
8375 {
8376 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
8377 trans[i] = XFLOATINT (AREF (matrix, i));
8378 }
333b20bb 8379
4a8e312c
GM		 8380 if (NILP (color_adjust))
8381 color_adjust = make_number (0xffff / 2);
333b20bb 8382
4a8e312c
GM		 8383 if (i == 9 && NUMBERP (color_adjust))
8384 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
333b20bb
GM		 8385}
8386
8387
14819cb3
GM		 8388/* Transform image IMG on frame F so that it looks disabled. */
8389
8390static void
8391x_disable_image (f, img)
8392 struct frame *f;
8393 struct image *img;
8394{
8395 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
dd00328a 8396
14819cb3
GM		 8397 if (dpyinfo->n_planes >= 2)
8398 {
8399 /* Color (or grayscale). Convert to gray, and equalize. Just
8400 drawing such images with a stipple can look very odd, so
8401 we're using this method instead. */
8402 XColor *colors = x_to_xcolors (f, img, 1);
8403 XColor *p, *end;
8404 const int h = 15000;
8405 const int l = 30000;
8406
8407 for (p = colors, end = colors + img->width * img->height;
8408 p < end;
8409 ++p)
8410 {
8411 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
8412 int i2 = (0xffff - h - l) * i / 0xffff + l;
8413 p->red = p->green = p->blue = i2;
8414 }
8415
8416 x_from_xcolors (f, img, colors);
8417 }
8418
8419 /* Draw a cross over the disabled image, if we must or if we
8420 should. */
8421 if (dpyinfo->n_planes < 2 || cross_disabled_images)
8422 {
8423 Display *dpy = FRAME_X_DISPLAY (f);
8424 GC gc;
8425
14819cb3
GM		 8426 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
8427 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
8428 XDrawLine (dpy, img->pixmap, gc, 0, 0,
8429 img->width - 1, img->height - 1);
8430 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
8431 img->width - 1, 0);
8432 XFreeGC (dpy, gc);
8433
8434 if (img->mask)
8435 {
8436 gc = XCreateGC (dpy, img->mask, 0, NULL);
8437 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
8438 XDrawLine (dpy, img->mask, gc, 0, 0,
8439 img->width - 1, img->height - 1);
8440 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
8441 img->width - 1, 0);
8442 XFreeGC (dpy, gc);
8443 }
14819cb3
GM		 8444 }
8445}
8446
8447
333b20bb
GM		 8448/* Build a mask for image IMG which is used on frame F. FILE is the
8449 name of an image file, for error messages. HOW determines how to
fcf431dc
GM		 8450 determine the background color of IMG. If it is a list '(R G B)',
8451 with R, G, and B being integers >= 0, take that as the color of the
8452 background. Otherwise, determine the background color of IMG
8453 heuristically. Value is non-zero if successful. */
333b20bb
GM		 8454
8455static int
45158a91 8456x_build_heuristic_mask (f, img, how)
333b20bb 8457 struct frame *f;
333b20bb
GM		 8458 struct image *img;
8459 Lisp_Object how;
8460{
8461 Display *dpy = FRAME_X_DISPLAY (f);
333b20bb 8462 XImage *ximg, *mask_img;
f20a3b7a 8463 int x, y, rc, use_img_background;
8ec8a5ec 8464 unsigned long bg = 0;
333b20bb 8465
4a8e312c
GM		 8466 if (img->mask)
8467 {
8468 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 8469 img->mask = None;
f20a3b7a 8470 img->background_transparent_valid = 0;
4a8e312c 8471 }
dd00328a 8472
333b20bb 8473 /* Create an image and pixmap serving as mask. */
45158a91 8474 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
333b20bb
GM		 8475 &mask_img, &img->mask);
8476 if (!rc)
28c7826c 8477 return 0;
333b20bb
GM		 8478
8479 /* Get the X image of IMG->pixmap. */
8480 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
8481 ~0, ZPixmap);
8482
fcf431dc 8483 /* Determine the background color of ximg. If HOW is `(R G B)'
f20a3b7a
MB		 8484 take that as color. Otherwise, use the image's background color. */
8485 use_img_background = 1;
488dd4c4 8486
fcf431dc
GM		 8487 if (CONSP (how))
8488 {
cac1daf0 8489 int rgb[3], i;
fcf431dc 8490
cac1daf0 8491 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
fcf431dc
GM		 8492 {
8493 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
8494 how = XCDR (how);
8495 }
8496
8497 if (i == 3 && NILP (how))
8498 {
8499 char color_name[30];
fcf431dc 8500 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
053b3256
GM		 8501 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
8502 use_img_background = 0;
fcf431dc
GM		 8503 }
8504 }
488dd4c4 8505
f20a3b7a 8506 if (use_img_background)
43f7c3ea 8507 bg = four_corners_best (ximg, img->width, img->height);
333b20bb
GM		 8508
8509 /* Set all bits in mask_img to 1 whose color in ximg is different
8510 from the background color bg. */
8511 for (y = 0; y < img->height; ++y)
8512 for (x = 0; x < img->width; ++x)
8513 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
8514
f20a3b7a
MB		 8515 /* Fill in the background_transparent field while we have the mask handy. */
8516 image_background_transparent (img, f, mask_img);
8517
333b20bb
GM		 8518 /* Put mask_img into img->mask. */
8519 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8520 x_destroy_x_image (mask_img);
8521 XDestroyImage (ximg);
488dd4c4 8522
333b20bb
GM		 8523 return 1;
8524}
8525
8526
8527\f
8528/***********************************************************************
8529 PBM (mono, gray, color)
8530 ***********************************************************************/
8531
8532static int pbm_image_p P_ ((Lisp_Object object));
8533static int pbm_load P_ ((struct frame *f, struct image *img));
63cec32f 8534static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
333b20bb
GM		 8535
8536/* The symbol `pbm' identifying images of this type. */
8537
8538Lisp_Object Qpbm;
8539
8540/* Indices of image specification fields in gs_format, below. */
8541
8542enum pbm_keyword_index
8543{
8544 PBM_TYPE,
8545 PBM_FILE,
63cec32f 8546 PBM_DATA,
333b20bb
GM		 8547 PBM_ASCENT,
8548 PBM_MARGIN,
8549 PBM_RELIEF,
8550 PBM_ALGORITHM,
8551 PBM_HEURISTIC_MASK,
4a8e312c 8552 PBM_MASK,
be0b1fac
GM		 8553 PBM_FOREGROUND,
8554 PBM_BACKGROUND,
333b20bb
GM		 8555 PBM_LAST
8556};
8557
8558/* Vector of image_keyword structures describing the format
8559 of valid user-defined image specifications. */
8560
8561static struct image_keyword pbm_format[PBM_LAST] =
8562{
8563 {":type", IMAGE_SYMBOL_VALUE, 1},
63cec32f
GM		 8564 {":file", IMAGE_STRING_VALUE, 0},
8565 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8566 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8567 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8568 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8569 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 8570 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
be0b1fac 8571 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM		 8572 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8573 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 8574};
8575
8576/* Structure describing the image type `pbm'. */
8577
8578static struct image_type pbm_type =
8579{
8580 &Qpbm,
8581 pbm_image_p,
8582 pbm_load,
8583 x_clear_image,
8584 NULL
8585};
8586
8587
8588/* Return non-zero if OBJECT is a valid PBM image specification. */
8589
8590static int
8591pbm_image_p (object)
8592 Lisp_Object object;
8593{
8594 struct image_keyword fmt[PBM_LAST];
488dd4c4 8595
333b20bb 8596 bcopy (pbm_format, fmt, sizeof fmt);
488dd4c4 8597
7c7ff7f5 8598 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
333b20bb 8599 return 0;
63cec32f
GM		 8600
8601 /* Must specify either :data or :file. */
8602 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
333b20bb
GM		 8603}
8604
8605
63cec32f
GM		 8606/* Scan a decimal number from *S and return it. Advance *S while
8607 reading the number. END is the end of the string. Value is -1 at
8608 end of input. */
333b20bb
GM		 8609
8610static int
63cec32f
GM		 8611pbm_scan_number (s, end)
8612 unsigned char **s, *end;
333b20bb 8613{
8ec8a5ec 8614 int c = 0, val = -1;
333b20bb 8615
63cec32f 8616 while (*s < end)
333b20bb
GM		 8617 {
8618 /* Skip white-space. */
63cec32f 8619 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM		 8620 ;
8621
8622 if (c == '#')
8623 {
8624 /* Skip comment to end of line. */
63cec32f 8625 while (*s < end && (c = *(*s)++, c != '\n'))
333b20bb
GM		 8626 ;
8627 }
8628 else if (isdigit (c))
8629 {
8630 /* Read decimal number. */
8631 val = c - '0';
63cec32f 8632 while (*s < end && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 8633 val = 10 * val + c - '0';
8634 break;
8635 }
8636 else
8637 break;
8638 }
8639
8640 return val;
8641}
8642
8643
8644/* Load PBM image IMG for use on frame F. */
8645
488dd4c4 8646static int
333b20bb
GM		 8647pbm_load (f, img)
8648 struct frame *f;
8649 struct image *img;
8650{
333b20bb 8651 int raw_p, x, y;
b6d7acec 8652 int width, height, max_color_idx = 0;
333b20bb
GM		 8653 XImage *ximg;
8654 Lisp_Object file, specified_file;
8655 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
8656 struct gcpro gcpro1;
63cec32f
GM		 8657 unsigned char *contents = NULL;
8658 unsigned char *end, *p;
8659 int size;
333b20bb
GM		 8660
8661 specified_file = image_spec_value (img->spec, QCfile, NULL);
63cec32f 8662 file = Qnil;
333b20bb 8663 GCPRO1 (file);
333b20bb 8664
63cec32f 8665 if (STRINGP (specified_file))
333b20bb 8666 {
63cec32f
GM		 8667 file = x_find_image_file (specified_file);
8668 if (!STRINGP (file))
8669 {
8670 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8671 UNGCPRO;
8672 return 0;
8673 }
333b20bb 8674
d5db4077 8675 contents = slurp_file (SDATA (file), &size);
63cec32f
GM		 8676 if (contents == NULL)
8677 {
8678 image_error ("Error reading `%s'", file, Qnil);
8679 UNGCPRO;
8680 return 0;
8681 }
8682
8683 p = contents;
8684 end = contents + size;
8685 }
8686 else
333b20bb 8687 {
63cec32f
GM		 8688 Lisp_Object data;
8689 data = image_spec_value (img->spec, QCdata, NULL);
d5db4077
KR		 8690 p = SDATA (data);
8691 end = p + SBYTES (data);
333b20bb
GM		 8692 }
8693
63cec32f
GM		 8694 /* Check magic number. */
8695 if (end - p < 2 || *p++ != 'P')
333b20bb 8696 {
45158a91 8697 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f
GM		 8698 error:
8699 xfree (contents);
333b20bb
GM		 8700 UNGCPRO;
8701 return 0;
8702 }
8703
63cec32f 8704 switch (*p++)
333b20bb
GM		 8705 {
8706 case '1':
8707 raw_p = 0, type = PBM_MONO;
8708 break;
488dd4c4 8709
333b20bb
GM		 8710 case '2':
8711 raw_p = 0, type = PBM_GRAY;
8712 break;
8713
8714 case '3':
8715 raw_p = 0, type = PBM_COLOR;
8716 break;
8717
8718 case '4':
8719 raw_p = 1, type = PBM_MONO;
8720 break;
488dd4c4 8721
333b20bb
GM		 8722 case '5':
8723 raw_p = 1, type = PBM_GRAY;
8724 break;
488dd4c4 8725
333b20bb
GM		 8726 case '6':
8727 raw_p = 1, type = PBM_COLOR;
8728 break;
8729
8730 default:
45158a91 8731 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f 8732 goto error;
333b20bb
GM		 8733 }
8734
8735 /* Read width, height, maximum color-component. Characters
8736 starting with `#' up to the end of a line are ignored. */
63cec32f
GM		 8737 width = pbm_scan_number (&p, end);
8738 height = pbm_scan_number (&p, end);
333b20bb
GM		 8739
8740 if (type != PBM_MONO)
8741 {
63cec32f 8742 max_color_idx = pbm_scan_number (&p, end);
333b20bb
GM		 8743 if (raw_p && max_color_idx > 255)
8744 max_color_idx = 255;
8745 }
488dd4c4 8746
63cec32f
GM		 8747 if (width < 0
8748 || height < 0
333b20bb 8749 || (type != PBM_MONO && max_color_idx < 0))
63cec32f 8750 goto error;
333b20bb 8751
45158a91 8752 if (!x_create_x_image_and_pixmap (f, width, height, 0,
333b20bb 8753 &ximg, &img->pixmap))
28c7826c 8754 goto error;
488dd4c4 8755
333b20bb
GM		 8756 /* Initialize the color hash table. */
8757 init_color_table ();
8758
8759 if (type == PBM_MONO)
8760 {
8761 int c = 0, g;
be0b1fac
GM		 8762 struct image_keyword fmt[PBM_LAST];
8763 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
8764 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
8765
8766 /* Parse the image specification. */
8767 bcopy (pbm_format, fmt, sizeof fmt);
8768 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
488dd4c4 8769
be0b1fac 8770 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM		 8771 if (fmt[PBM_FOREGROUND].count
8772 && STRINGP (fmt[PBM_FOREGROUND].value))
be0b1fac 8773 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
6f1be3b9
GM		 8774 if (fmt[PBM_BACKGROUND].count
8775 && STRINGP (fmt[PBM_BACKGROUND].value))
f20a3b7a
MB		 8776 {
8777 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
8778 img->background = bg;
8779 img->background_valid = 1;
8780 }
488dd4c4 8781
333b20bb
GM		 8782 for (y = 0; y < height; ++y)
8783 for (x = 0; x < width; ++x)
8784 {
8785 if (raw_p)
8786 {
8787 if ((x & 7) == 0)
63cec32f 8788 c = *p++;
333b20bb
GM		 8789 g = c & 0x80;
8790 c <<= 1;
8791 }
8792 else
63cec32f 8793 g = pbm_scan_number (&p, end);
333b20bb 8794
be0b1fac 8795 XPutPixel (ximg, x, y, g ? fg : bg);
333b20bb
GM		 8796 }
8797 }
8798 else
8799 {
8800 for (y = 0; y < height; ++y)
8801 for (x = 0; x < width; ++x)
8802 {
8803 int r, g, b;
488dd4c4 8804
333b20bb 8805 if (type == PBM_GRAY)
63cec32f 8806 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
333b20bb
GM		 8807 else if (raw_p)
8808 {
63cec32f
GM		 8809 r = *p++;
8810 g = *p++;
8811 b = *p++;
333b20bb
GM		 8812 }
8813 else
8814 {
63cec32f
GM		 8815 r = pbm_scan_number (&p, end);
8816 g = pbm_scan_number (&p, end);
8817 b = pbm_scan_number (&p, end);
333b20bb 8818 }
488dd4c4 8819
333b20bb
GM		 8820 if (r < 0 || g < 0 || b < 0)
8821 {
333b20bb
GM		 8822 xfree (ximg->data);
8823 ximg->data = NULL;
8824 XDestroyImage (ximg);
45158a91
GM		 8825 image_error ("Invalid pixel value in image `%s'",
8826 img->spec, Qnil);
63cec32f 8827 goto error;
333b20bb 8828 }
488dd4c4 8829
333b20bb
GM		 8830 /* RGB values are now in the range 0..max_color_idx.
8831 Scale this to the range 0..0xffff supported by X. */
8832 r = (double) r * 65535 / max_color_idx;
8833 g = (double) g * 65535 / max_color_idx;
8834 b = (double) b * 65535 / max_color_idx;
8835 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8836 }
8837 }
488dd4c4 8838
333b20bb
GM		 8839 /* Store in IMG->colors the colors allocated for the image, and
8840 free the color table. */
8841 img->colors = colors_in_color_table (&img->ncolors);
8842 free_color_table ();
f20a3b7a
MB		 8843
8844 /* Maybe fill in the background field while we have ximg handy. */
8845 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8846 IMAGE_BACKGROUND (img, f, ximg);
488dd4c4 8847
333b20bb
GM		 8848 /* Put the image into a pixmap. */
8849 x_put_x_image (f, ximg, img->pixmap, width, height);
8850 x_destroy_x_image (ximg);
488dd4c4 8851
333b20bb
GM		 8852 img->width = width;
8853 img->height = height;
8854
8855 UNGCPRO;
63cec32f 8856 xfree (contents);
333b20bb
GM		 8857 return 1;
8858}
8859
8860
8861\f
8862/***********************************************************************
8863 PNG
8864 ***********************************************************************/
8865
8866#if HAVE_PNG
8867
8868#include <png.h>
8869
8870/* Function prototypes. */
8871
8872static int png_image_p P_ ((Lisp_Object object));
8873static int png_load P_ ((struct frame *f, struct image *img));
8874
8875/* The symbol `png' identifying images of this type. */
8876
8877Lisp_Object Qpng;
8878
8879/* Indices of image specification fields in png_format, below. */
8880
8881enum png_keyword_index
8882{
8883 PNG_TYPE,
63448a4d 8884 PNG_DATA,
333b20bb
GM		 8885 PNG_FILE,
8886 PNG_ASCENT,
8887 PNG_MARGIN,
8888 PNG_RELIEF,
8889 PNG_ALGORITHM,
8890 PNG_HEURISTIC_MASK,
4a8e312c 8891 PNG_MASK,
f20a3b7a 8892 PNG_BACKGROUND,
333b20bb
GM		 8893 PNG_LAST
8894};
8895
8896/* Vector of image_keyword structures describing the format
8897 of valid user-defined image specifications. */
8898
8899static struct image_keyword png_format[PNG_LAST] =
8900{
8901 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 8902 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 8903 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8904 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8905 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8906 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8907 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 8908 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f2f0a644 8909 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a 8910 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 8911};
8912
06482119 8913/* Structure describing the image type `png'. */
333b20bb
GM		 8914
8915static struct image_type png_type =
8916{
8917 &Qpng,
8918 png_image_p,
8919 png_load,
8920 x_clear_image,
8921 NULL
8922};
8923
8924
8925/* Return non-zero if OBJECT is a valid PNG image specification. */
8926
8927static int
8928png_image_p (object)
8929 Lisp_Object object;
8930{
8931 struct image_keyword fmt[PNG_LAST];
8932 bcopy (png_format, fmt, sizeof fmt);
488dd4c4 8933
7c7ff7f5 8934 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
333b20bb 8935 return 0;
63448a4d 8936
63cec32f
GM		 8937 /* Must specify either the :data or :file keyword. */
8938 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
333b20bb
GM		 8939}
8940
8941
8942/* Error and warning handlers installed when the PNG library
8943 is initialized. */
8944
8945static void
8946my_png_error (png_ptr, msg)
8947 png_struct *png_ptr;
8948 char *msg;
8949{
8950 xassert (png_ptr != NULL);
8951 image_error ("PNG error: %s", build_string (msg), Qnil);
8952 longjmp (png_ptr->jmpbuf, 1);
8953}
8954
8955
8956static void
8957my_png_warning (png_ptr, msg)
8958 png_struct *png_ptr;
8959 char *msg;
8960{
8961 xassert (png_ptr != NULL);
8962 image_error ("PNG warning: %s", build_string (msg), Qnil);
8963}
8964
5ad6a5fb
GM		 8965/* Memory source for PNG decoding. */
8966
63448a4d
WP		 8967struct png_memory_storage
8968{
5ad6a5fb
GM		 8969 unsigned char *bytes; /* The data */
8970 size_t len; /* How big is it? */
8971 int index; /* Where are we? */
63448a4d
WP		 8972};
8973
5ad6a5fb
GM		 8974
8975/* Function set as reader function when reading PNG image from memory.
8976 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8977 bytes from the input to DATA. */
8978
63448a4d 8979static void
5ad6a5fb
GM		 8980png_read_from_memory (png_ptr, data, length)
8981 png_structp png_ptr;
8982 png_bytep data;
8983 png_size_t length;
63448a4d 8984{
5ad6a5fb
GM		 8985 struct png_memory_storage *tbr
8986 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
63448a4d 8987
5ad6a5fb
GM		 8988 if (length > tbr->len - tbr->index)
8989 png_error (png_ptr, "Read error");
488dd4c4 8990
5ad6a5fb
GM		 8991 bcopy (tbr->bytes + tbr->index, data, length);
8992 tbr->index = tbr->index + length;
63448a4d 8993}
333b20bb
GM		 8994
8995/* Load PNG image IMG for use on frame F. Value is non-zero if
8996 successful. */
8997
8998static int
8999png_load (f, img)
9000 struct frame *f;
9001 struct image *img;
9002{
9003 Lisp_Object file, specified_file;
63448a4d 9004 Lisp_Object specified_data;
b6d7acec 9005 int x, y, i;
333b20bb
GM		 9006 XImage *ximg, *mask_img = NULL;
9007 struct gcpro gcpro1;
9008 png_struct *png_ptr = NULL;
9009 png_info *info_ptr = NULL, *end_info = NULL;
8ec8a5ec 9010 FILE *volatile fp = NULL;
333b20bb 9011 png_byte sig[8];
8ec8a5ec
GM		 9012 png_byte * volatile pixels = NULL;
9013 png_byte ** volatile rows = NULL;
333b20bb
GM		 9014 png_uint_32 width, height;
9015 int bit_depth, color_type, interlace_type;
9016 png_byte channels;
9017 png_uint_32 row_bytes;
9018 int transparent_p;
333b20bb
GM		 9019 double screen_gamma, image_gamma;
9020 int intent;
63448a4d 9021 struct png_memory_storage tbr; /* Data to be read */
333b20bb
GM		 9022
9023 /* Find out what file to load. */
9024 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9025 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9026 file = Qnil;
9027 GCPRO1 (file);
333b20bb 9028
63448a4d 9029 if (NILP (specified_data))
5ad6a5fb
GM		 9030 {
9031 file = x_find_image_file (specified_file);
9032 if (!STRINGP (file))
63448a4d 9033 {
45158a91 9034 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM		 9035 UNGCPRO;
9036 return 0;
9037 }
333b20bb 9038
5ad6a5fb 9039 /* Open the image file. */
d5db4077 9040 fp = fopen (SDATA (file), "rb");
5ad6a5fb
GM		 9041 if (!fp)
9042 {
45158a91 9043 image_error ("Cannot open image file `%s'", file, Qnil);
5ad6a5fb
GM		 9044 UNGCPRO;
9045 fclose (fp);
9046 return 0;
9047 }
63448a4d 9048
5ad6a5fb
GM		 9049 /* Check PNG signature. */
9050 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
9051 || !png_check_sig (sig, sizeof sig))
9052 {
45158a91 9053 image_error ("Not a PNG file: `%s'", file, Qnil);
5ad6a5fb
GM		 9054 UNGCPRO;
9055 fclose (fp);
9056 return 0;
63448a4d 9057 }
5ad6a5fb 9058 }
63448a4d 9059 else
5ad6a5fb
GM		 9060 {
9061 /* Read from memory. */
d5db4077
KR		 9062 tbr.bytes = SDATA (specified_data);
9063 tbr.len = SBYTES (specified_data);
5ad6a5fb 9064 tbr.index = 0;
63448a4d 9065
5ad6a5fb
GM		 9066 /* Check PNG signature. */
9067 if (tbr.len < sizeof sig
9068 || !png_check_sig (tbr.bytes, sizeof sig))
9069 {
45158a91 9070 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
5ad6a5fb
GM		 9071 UNGCPRO;
9072 return 0;
63448a4d 9073 }
333b20bb 9074
5ad6a5fb
GM		 9075 /* Need to skip past the signature. */
9076 tbr.bytes += sizeof (sig);
9077 }
9078
333b20bb
GM		 9079 /* Initialize read and info structs for PNG lib. */
9080 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
9081 my_png_error, my_png_warning);
9082 if (!png_ptr)
9083 {
63448a4d 9084 if (fp) fclose (fp);
333b20bb
GM		 9085 UNGCPRO;
9086 return 0;
9087 }
9088
9089 info_ptr = png_create_info_struct (png_ptr);
9090 if (!info_ptr)
9091 {
9092 png_destroy_read_struct (&png_ptr, NULL, NULL);
63448a4d 9093 if (fp) fclose (fp);
333b20bb
GM		 9094 UNGCPRO;
9095 return 0;
9096 }
9097
9098 end_info = png_create_info_struct (png_ptr);
9099 if (!end_info)
9100 {
9101 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
63448a4d 9102 if (fp) fclose (fp);
333b20bb
GM		 9103 UNGCPRO;
9104 return 0;
9105 }
9106
9107 /* Set error jump-back. We come back here when the PNG library
9108 detects an error. */
9109 if (setjmp (png_ptr->jmpbuf))
9110 {
9111 error:
9112 if (png_ptr)
9113 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
9114 xfree (pixels);
9115 xfree (rows);
63448a4d 9116 if (fp) fclose (fp);
333b20bb
GM		 9117 UNGCPRO;
9118 return 0;
9119 }
9120
9121 /* Read image info. */
63448a4d 9122 if (!NILP (specified_data))
5ad6a5fb 9123 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
63448a4d 9124 else
5ad6a5fb 9125 png_init_io (png_ptr, fp);
63448a4d 9126
333b20bb
GM		 9127 png_set_sig_bytes (png_ptr, sizeof sig);
9128 png_read_info (png_ptr, info_ptr);
9129 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
9130 &interlace_type, NULL, NULL);
9131
488dd4c4 9132 /* If image contains simply transparency data, we prefer to
333b20bb
GM		 9133 construct a clipping mask. */
9134 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
9135 transparent_p = 1;
9136 else
9137 transparent_p = 0;
9138
488dd4c4 9139 /* This function is easier to write if we only have to handle
333b20bb
GM		 9140 one data format: RGB or RGBA with 8 bits per channel. Let's
9141 transform other formats into that format. */
9142
9143 /* Strip more than 8 bits per channel. */
9144 if (bit_depth == 16)
9145 png_set_strip_16 (png_ptr);
9146
9147 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9148 if available. */
9149 png_set_expand (png_ptr);
9150
9151 /* Convert grayscale images to RGB. */
488dd4c4 9152 if (color_type == PNG_COLOR_TYPE_GRAY
333b20bb
GM		 9153 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
9154 png_set_gray_to_rgb (png_ptr);
9155
d4405ed7 9156 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
333b20bb 9157
bfa261c0 9158#if 0 /* Avoid double gamma correction for PNG images. */
333b20bb 9159 /* Tell the PNG lib to handle gamma correction for us. */
6c1aa34d 9160#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
333b20bb 9161 if (png_get_sRGB (png_ptr, info_ptr, &intent))
d4405ed7
RS		 9162 /* The libpng documentation says this is right in this case. */
9163 png_set_gamma (png_ptr, screen_gamma, 0.45455);
6c1aa34d
GM		 9164 else
9165#endif
9166 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
333b20bb
GM		 9167 /* Image contains gamma information. */
9168 png_set_gamma (png_ptr, screen_gamma, image_gamma);
9169 else
d4405ed7
RS		 9170 /* Use the standard default for the image gamma. */
9171 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7273d100 9172#endif /* if 0 */
333b20bb
GM		 9173
9174 /* Handle alpha channel by combining the image with a background
9175 color. Do this only if a real alpha channel is supplied. For
9176 simple transparency, we prefer a clipping mask. */
9177 if (!transparent_p)
9178 {
f20a3b7a
MB		 9179 png_color_16 *image_bg;
9180 Lisp_Object specified_bg
9181 = image_spec_value (img->spec, QCbackground, NULL);
9182
f2f0a644 9183 if (STRINGP (specified_bg))
f20a3b7a
MB		 9184 /* The user specified `:background', use that. */
9185 {
9186 XColor color;
d5db4077 9187 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
f20a3b7a
MB		 9188 {
9189 png_color_16 user_bg;
9190
9191 bzero (&user_bg, sizeof user_bg);
9192 user_bg.red = color.red;
9193 user_bg.green = color.green;
9194 user_bg.blue = color.blue;
333b20bb 9195
f20a3b7a
MB		 9196 png_set_background (png_ptr, &user_bg,
9197 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
9198 }
9199 }
9200 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
488dd4c4 9201 /* Image contains a background color with which to
333b20bb 9202 combine the image. */
f20a3b7a 9203 png_set_background (png_ptr, image_bg,
333b20bb
GM		 9204 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
9205 else
9206 {
9207 /* Image does not contain a background color with which
488dd4c4 9208 to combine the image data via an alpha channel. Use
333b20bb
GM		 9209 the frame's background instead. */
9210 XColor color;
9211 Colormap cmap;
9212 png_color_16 frame_background;
9213
9b2956e2 9214 cmap = FRAME_X_COLORMAP (f);
333b20bb 9215 color.pixel = FRAME_BACKGROUND_PIXEL (f);
a31fedb7 9216 x_query_color (f, &color);
333b20bb
GM		 9217
9218 bzero (&frame_background, sizeof frame_background);
9219 frame_background.red = color.red;
9220 frame_background.green = color.green;
9221 frame_background.blue = color.blue;
9222
9223 png_set_background (png_ptr, &frame_background,
9224 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
9225 }
9226 }
9227
9228 /* Update info structure. */
9229 png_read_update_info (png_ptr, info_ptr);
9230
9231 /* Get number of channels. Valid values are 1 for grayscale images
9232 and images with a palette, 2 for grayscale images with transparency
9233 information (alpha channel), 3 for RGB images, and 4 for RGB
9234 images with alpha channel, i.e. RGBA. If conversions above were
9235 sufficient we should only have 3 or 4 channels here. */
9236 channels = png_get_channels (png_ptr, info_ptr);
9237 xassert (channels == 3 || channels == 4);
9238
9239 /* Number of bytes needed for one row of the image. */
9240 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
9241
9242 /* Allocate memory for the image. */
9243 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
9244 rows = (png_byte **) xmalloc (height * sizeof *rows);
9245 for (i = 0; i < height; ++i)
9246 rows[i] = pixels + i * row_bytes;
9247
9248 /* Read the entire image. */
9249 png_read_image (png_ptr, rows);
9250 png_read_end (png_ptr, info_ptr);
5ad6a5fb
GM		 9251 if (fp)
9252 {
9253 fclose (fp);
9254 fp = NULL;
9255 }
488dd4c4 9256
333b20bb 9257 /* Create the X image and pixmap. */
45158a91 9258 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
333b20bb 9259 &img->pixmap))
28c7826c 9260 goto error;
488dd4c4 9261
333b20bb
GM		 9262 /* Create an image and pixmap serving as mask if the PNG image
9263 contains an alpha channel. */
9264 if (channels == 4
9265 && !transparent_p
45158a91 9266 && !x_create_x_image_and_pixmap (f, width, height, 1,
333b20bb
GM		 9267 &mask_img, &img->mask))
9268 {
9269 x_destroy_x_image (ximg);
9270 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 9271 img->pixmap = None;
333b20bb
GM		 9272 goto error;
9273 }
9274
9275 /* Fill the X image and mask from PNG data. */
9276 init_color_table ();
9277
9278 for (y = 0; y < height; ++y)
9279 {
9280 png_byte *p = rows[y];
9281
9282 for (x = 0; x < width; ++x)
9283 {
9284 unsigned r, g, b;
9285
9286 r = *p++ << 8;
9287 g = *p++ << 8;
9288 b = *p++ << 8;
9289 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
9290
9291 /* An alpha channel, aka mask channel, associates variable
488dd4c4
JD		 9292 transparency with an image. Where other image formats
9293 support binary transparency---fully transparent or fully
333b20bb
GM		 9294 opaque---PNG allows up to 254 levels of partial transparency.
9295 The PNG library implements partial transparency by combining
9296 the image with a specified background color.
9297
9298 I'm not sure how to handle this here nicely: because the
9299 background on which the image is displayed may change, for
488dd4c4
JD		 9300 real alpha channel support, it would be necessary to create
9301 a new image for each possible background.
333b20bb
GM		 9302
9303 What I'm doing now is that a mask is created if we have
9304 boolean transparency information. Otherwise I'm using
9305 the frame's background color to combine the image with. */
9306
9307 if (channels == 4)
9308 {
9309 if (mask_img)
9310 XPutPixel (mask_img, x, y, *p > 0);
9311 ++p;
9312 }
9313 }
9314 }
9315
f20a3b7a
MB		 9316 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9317 /* Set IMG's background color from the PNG image, unless the user
9318 overrode it. */
9319 {
9320 png_color_16 *bg;
9321 if (png_get_bKGD (png_ptr, info_ptr, &bg))
9322 {
f2f0a644 9323 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
f20a3b7a
MB		 9324 img->background_valid = 1;
9325 }
9326 }
9327
333b20bb
GM		 9328 /* Remember colors allocated for this image. */
9329 img->colors = colors_in_color_table (&img->ncolors);
9330 free_color_table ();
9331
9332 /* Clean up. */
9333 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
9334 xfree (rows);
9335 xfree (pixels);
9336
9337 img->width = width;
9338 img->height = height;
9339
f20a3b7a
MB		 9340 /* Maybe fill in the background field while we have ximg handy. */
9341 IMAGE_BACKGROUND (img, f, ximg);
9342
333b20bb
GM		 9343 /* Put the image into the pixmap, then free the X image and its buffer. */
9344 x_put_x_image (f, ximg, img->pixmap, width, height);
9345 x_destroy_x_image (ximg);
9346
9347 /* Same for the mask. */
9348 if (mask_img)
9349 {
f20a3b7a
MB		 9350 /* Fill in the background_transparent field while we have the mask
9351 handy. */
9352 image_background_transparent (img, f, mask_img);
9353
333b20bb
GM		 9354 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
9355 x_destroy_x_image (mask_img);
9356 }
9357
333b20bb
GM		 9358 UNGCPRO;
9359 return 1;
9360}
9361
9362#endif /* HAVE_PNG != 0 */
9363
9364
9365\f
9366/***********************************************************************
9367 JPEG
9368 ***********************************************************************/
9369
9370#if HAVE_JPEG
9371
ba06aba4
GM		 9372/* Work around a warning about HAVE_STDLIB_H being redefined in
9373 jconfig.h. */
9374#ifdef HAVE_STDLIB_H
9375#define HAVE_STDLIB_H_1
9376#undef HAVE_STDLIB_H
9377#endif /* HAVE_STLIB_H */
9378
333b20bb
GM		 9379#include <jpeglib.h>
9380#include <jerror.h>
9381#include <setjmp.h>
9382
ba06aba4
GM		 9383#ifdef HAVE_STLIB_H_1
9384#define HAVE_STDLIB_H 1
9385#endif
9386
333b20bb
GM		 9387static int jpeg_image_p P_ ((Lisp_Object object));
9388static int jpeg_load P_ ((struct frame *f, struct image *img));
9389
9390/* The symbol `jpeg' identifying images of this type. */
9391
9392Lisp_Object Qjpeg;
9393
9394/* Indices of image specification fields in gs_format, below. */
9395
9396enum jpeg_keyword_index
9397{
9398 JPEG_TYPE,
8e39770a 9399 JPEG_DATA,
333b20bb
GM		 9400 JPEG_FILE,
9401 JPEG_ASCENT,
9402 JPEG_MARGIN,
9403 JPEG_RELIEF,
9404 JPEG_ALGORITHM,
9405 JPEG_HEURISTIC_MASK,
4a8e312c 9406 JPEG_MASK,
f20a3b7a 9407 JPEG_BACKGROUND,
333b20bb
GM		 9408 JPEG_LAST
9409};
9410
9411/* Vector of image_keyword structures describing the format
9412 of valid user-defined image specifications. */
9413
9414static struct image_keyword jpeg_format[JPEG_LAST] =
9415{
9416 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9417 {":data", IMAGE_STRING_VALUE, 0},
8e39770a 9418 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9419 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9420 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9421 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9422 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 9423 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 9424 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9425 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 9426};
9427
9428/* Structure describing the image type `jpeg'. */
9429
9430static struct image_type jpeg_type =
9431{
9432 &Qjpeg,
9433 jpeg_image_p,
9434 jpeg_load,
9435 x_clear_image,
9436 NULL
9437};
9438
9439
9440/* Return non-zero if OBJECT is a valid JPEG image specification. */
9441
9442static int
9443jpeg_image_p (object)
9444 Lisp_Object object;
9445{
9446 struct image_keyword fmt[JPEG_LAST];
488dd4c4 9447
333b20bb 9448 bcopy (jpeg_format, fmt, sizeof fmt);
488dd4c4 9449
7c7ff7f5 9450 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
333b20bb 9451 return 0;
8e39770a 9452
63cec32f
GM		 9453 /* Must specify either the :data or :file keyword. */
9454 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
333b20bb
GM		 9455}
9456
8e39770a 9457
333b20bb
GM		 9458struct my_jpeg_error_mgr
9459{
9460 struct jpeg_error_mgr pub;
9461 jmp_buf setjmp_buffer;
9462};
9463
e3130015 9464
333b20bb
GM		 9465static void
9466my_error_exit (cinfo)
9467 j_common_ptr cinfo;
9468{
9469 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
9470 longjmp (mgr->setjmp_buffer, 1);
9471}
9472
e3130015 9473
8e39770a
GM		 9474/* Init source method for JPEG data source manager. Called by
9475 jpeg_read_header() before any data is actually read. See
9476 libjpeg.doc from the JPEG lib distribution. */
9477
9478static void
9479our_init_source (cinfo)
9480 j_decompress_ptr cinfo;
9481{
9482}
9483
9484
9485/* Fill input buffer method for JPEG data source manager. Called
9486 whenever more data is needed. We read the whole image in one step,
9487 so this only adds a fake end of input marker at the end. */
9488
9489static boolean
9490our_fill_input_buffer (cinfo)
9491 j_decompress_ptr cinfo;
9492{
9493 /* Insert a fake EOI marker. */
9494 struct jpeg_source_mgr *src = cinfo->src;
9495 static JOCTET buffer[2];
9496
9497 buffer[0] = (JOCTET) 0xFF;
9498 buffer[1] = (JOCTET) JPEG_EOI;
9499
9500 src->next_input_byte = buffer;
9501 src->bytes_in_buffer = 2;
9502 return TRUE;
9503}
9504
9505
9506/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9507 is the JPEG data source manager. */
9508
9509static void
9510our_skip_input_data (cinfo, num_bytes)
9511 j_decompress_ptr cinfo;
9512 long num_bytes;
9513{
9514 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
9515
9516 if (src)
9517 {
9518 if (num_bytes > src->bytes_in_buffer)
5ad6a5fb 9519 ERREXIT (cinfo, JERR_INPUT_EOF);
488dd4c4 9520
8e39770a
GM		 9521 src->bytes_in_buffer -= num_bytes;
9522 src->next_input_byte += num_bytes;
9523 }
9524}
9525
9526
9527/* Method to terminate data source. Called by
9528 jpeg_finish_decompress() after all data has been processed. */
9529
9530static void
9531our_term_source (cinfo)
9532 j_decompress_ptr cinfo;
9533{
9534}
9535
9536
9537/* Set up the JPEG lib for reading an image from DATA which contains
9538 LEN bytes. CINFO is the decompression info structure created for
9539 reading the image. */
9540
9541static void
9542jpeg_memory_src (cinfo, data, len)
9543 j_decompress_ptr cinfo;
9544 JOCTET *data;
9545 unsigned int len;
9546{
9547 struct jpeg_source_mgr *src;
9548
9549 if (cinfo->src == NULL)
9550 {
9551 /* First time for this JPEG object? */
9552 cinfo->src = (struct jpeg_source_mgr *)
9553 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
9554 sizeof (struct jpeg_source_mgr));
9555 src = (struct jpeg_source_mgr *) cinfo->src;
9556 src->next_input_byte = data;
9557 }
488dd4c4 9558
8e39770a
GM		 9559 src = (struct jpeg_source_mgr *) cinfo->src;
9560 src->init_source = our_init_source;
9561 src->fill_input_buffer = our_fill_input_buffer;
9562 src->skip_input_data = our_skip_input_data;
9563 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
9564 src->term_source = our_term_source;
9565 src->bytes_in_buffer = len;
9566 src->next_input_byte = data;
9567}
9568
5ad6a5fb 9569
333b20bb
GM		 9570/* Load image IMG for use on frame F. Patterned after example.c
9571 from the JPEG lib. */
9572
488dd4c4 9573static int
333b20bb
GM		 9574jpeg_load (f, img)
9575 struct frame *f;
9576 struct image *img;
9577{
9578 struct jpeg_decompress_struct cinfo;
9579 struct my_jpeg_error_mgr mgr;
9580 Lisp_Object file, specified_file;
8e39770a 9581 Lisp_Object specified_data;
8ec8a5ec 9582 FILE * volatile fp = NULL;
333b20bb
GM		 9583 JSAMPARRAY buffer;
9584 int row_stride, x, y;
9585 XImage *ximg = NULL;
b6d7acec 9586 int rc;
333b20bb
GM		 9587 unsigned long *colors;
9588 int width, height;
9589 struct gcpro gcpro1;
9590
9591 /* Open the JPEG file. */
9592 specified_file = image_spec_value (img->spec, QCfile, NULL);
8e39770a 9593 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9594 file = Qnil;
9595 GCPRO1 (file);
8e39770a 9596
8e39770a 9597 if (NILP (specified_data))
333b20bb 9598 {
8e39770a 9599 file = x_find_image_file (specified_file);
8e39770a
GM		 9600 if (!STRINGP (file))
9601 {
45158a91 9602 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8e39770a
GM		 9603 UNGCPRO;
9604 return 0;
9605 }
488dd4c4 9606
d5db4077 9607 fp = fopen (SDATA (file), "r");
8e39770a
GM		 9608 if (fp == NULL)
9609 {
9610 image_error ("Cannot open `%s'", file, Qnil);
9611 UNGCPRO;
9612 return 0;
9613 }
333b20bb
GM		 9614 }
9615
5ad6a5fb
GM		 9616 /* Customize libjpeg's error handling to call my_error_exit when an
9617 error is detected. This function will perform a longjmp. */
333b20bb 9618 cinfo.err = jpeg_std_error (&mgr.pub);
14358466 9619 mgr.pub.error_exit = my_error_exit;
488dd4c4 9620
333b20bb
GM		 9621 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
9622 {
5ad6a5fb
GM		 9623 if (rc == 1)
9624 {
9625 /* Called from my_error_exit. Display a JPEG error. */
9626 char buffer[JMSG_LENGTH_MAX];
9627 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
45158a91 9628 image_error ("Error reading JPEG image `%s': %s", img->spec,
5ad6a5fb
GM		 9629 build_string (buffer));
9630 }
488dd4c4 9631
333b20bb 9632 /* Close the input file and destroy the JPEG object. */
5ad6a5fb 9633 if (fp)
8ec8a5ec 9634 fclose ((FILE *) fp);
333b20bb
GM		 9635 jpeg_destroy_decompress (&cinfo);
9636
5ad6a5fb
GM		 9637 /* If we already have an XImage, free that. */
9638 x_destroy_x_image (ximg);
333b20bb 9639
5ad6a5fb
GM		 9640 /* Free pixmap and colors. */
9641 x_clear_image (f, img);
488dd4c4 9642
5ad6a5fb
GM		 9643 UNGCPRO;
9644 return 0;
333b20bb
GM		 9645 }
9646
9647 /* Create the JPEG decompression object. Let it read from fp.
63448a4d 9648 Read the JPEG image header. */
333b20bb 9649 jpeg_create_decompress (&cinfo);
8e39770a
GM		 9650
9651 if (NILP (specified_data))
8ec8a5ec 9652 jpeg_stdio_src (&cinfo, (FILE *) fp);
8e39770a 9653 else
d5db4077
KR		 9654 jpeg_memory_src (&cinfo, SDATA (specified_data),
9655 SBYTES (specified_data));
63448a4d 9656
333b20bb
GM		 9657 jpeg_read_header (&cinfo, TRUE);
9658
9659 /* Customize decompression so that color quantization will be used.
63448a4d 9660 Start decompression. */
333b20bb
GM		 9661 cinfo.quantize_colors = TRUE;
9662 jpeg_start_decompress (&cinfo);
9663 width = img->width = cinfo.output_width;
9664 height = img->height = cinfo.output_height;
9665
333b20bb 9666 /* Create X image and pixmap. */
45158a91 9667 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
28c7826c 9668 longjmp (mgr.setjmp_buffer, 2);
333b20bb
GM		 9669
9670 /* Allocate colors. When color quantization is used,
5ad6a5fb
GM		 9671 cinfo.actual_number_of_colors has been set with the number of
9672 colors generated, and cinfo.colormap is a two-dimensional array
9673 of color indices in the range 0..cinfo.actual_number_of_colors.
9674 No more than 255 colors will be generated. */
333b20bb 9675 {
5ad6a5fb
GM		 9676 int i, ir, ig, ib;
9677
9678 if (cinfo.out_color_components > 2)
9679 ir = 0, ig = 1, ib = 2;
9680 else if (cinfo.out_color_components > 1)
9681 ir = 0, ig = 1, ib = 0;
9682 else
9683 ir = 0, ig = 0, ib = 0;
9684
9685 /* Use the color table mechanism because it handles colors that
9686 cannot be allocated nicely. Such colors will be replaced with
9687 a default color, and we don't have to care about which colors
9688 can be freed safely, and which can't. */
9689 init_color_table ();
9690 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
9691 * sizeof *colors);
488dd4c4 9692
5ad6a5fb
GM		 9693 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
9694 {
9695 /* Multiply RGB values with 255 because X expects RGB values
9696 in the range 0..0xffff. */
9697 int r = cinfo.colormap[ir][i] << 8;
9698 int g = cinfo.colormap[ig][i] << 8;
9699 int b = cinfo.colormap[ib][i] << 8;
9700 colors[i] = lookup_rgb_color (f, r, g, b);
9701 }
333b20bb 9702
5ad6a5fb
GM		 9703 /* Remember those colors actually allocated. */
9704 img->colors = colors_in_color_table (&img->ncolors);
9705 free_color_table ();
333b20bb
GM		 9706 }
9707
9708 /* Read pixels. */
9709 row_stride = width * cinfo.output_components;
9710 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
5ad6a5fb 9711 row_stride, 1);
333b20bb
GM		 9712 for (y = 0; y < height; ++y)
9713 {
5ad6a5fb
GM		 9714 jpeg_read_scanlines (&cinfo, buffer, 1);
9715 for (x = 0; x < cinfo.output_width; ++x)
9716 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
333b20bb
GM		 9717 }
9718
9719 /* Clean up. */
9720 jpeg_finish_decompress (&cinfo);
9721 jpeg_destroy_decompress (&cinfo);
5ad6a5fb 9722 if (fp)
8ec8a5ec 9723 fclose ((FILE *) fp);
f20a3b7a
MB		 9724
9725 /* Maybe fill in the background field while we have ximg handy. */
9726 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9727 IMAGE_BACKGROUND (img, f, ximg);
488dd4c4 9728
333b20bb
GM		 9729 /* Put the image into the pixmap. */
9730 x_put_x_image (f, ximg, img->pixmap, width, height);
9731 x_destroy_x_image (ximg);
333b20bb
GM		 9732 UNGCPRO;
9733 return 1;
9734}
9735
9736#endif /* HAVE_JPEG */
9737
9738
9739\f
9740/***********************************************************************
9741 TIFF
9742 ***********************************************************************/
9743
9744#if HAVE_TIFF
9745
cf4790ad 9746#include <tiffio.h>
333b20bb
GM		 9747
9748static int tiff_image_p P_ ((Lisp_Object object));
9749static int tiff_load P_ ((struct frame *f, struct image *img));
9750
9751/* The symbol `tiff' identifying images of this type. */
9752
9753Lisp_Object Qtiff;
9754
9755/* Indices of image specification fields in tiff_format, below. */
9756
9757enum tiff_keyword_index
9758{
9759 TIFF_TYPE,
63448a4d 9760 TIFF_DATA,
333b20bb
GM		 9761 TIFF_FILE,
9762 TIFF_ASCENT,
9763 TIFF_MARGIN,
9764 TIFF_RELIEF,
9765 TIFF_ALGORITHM,
9766 TIFF_HEURISTIC_MASK,
4a8e312c 9767 TIFF_MASK,
f20a3b7a 9768 TIFF_BACKGROUND,
333b20bb
GM		 9769 TIFF_LAST
9770};
9771
9772/* Vector of image_keyword structures describing the format
9773 of valid user-defined image specifications. */
9774
9775static struct image_keyword tiff_format[TIFF_LAST] =
9776{
9777 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9778 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 9779 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9780 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9781 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9782 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9783 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 9784 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 9785 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9786 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 9787};
9788
9789/* Structure describing the image type `tiff'. */
9790
9791static struct image_type tiff_type =
9792{
9793 &Qtiff,
9794 tiff_image_p,
9795 tiff_load,
9796 x_clear_image,
9797 NULL
9798};
9799
9800
9801/* Return non-zero if OBJECT is a valid TIFF image specification. */
9802
9803static int
9804tiff_image_p (object)
9805 Lisp_Object object;
9806{
9807 struct image_keyword fmt[TIFF_LAST];
9808 bcopy (tiff_format, fmt, sizeof fmt);
488dd4c4 9809
7c7ff7f5 9810 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
333b20bb 9811 return 0;
488dd4c4 9812
63cec32f
GM		 9813 /* Must specify either the :data or :file keyword. */
9814 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
333b20bb
GM		 9815}
9816
5ad6a5fb
GM		 9817
9818/* Reading from a memory buffer for TIFF images Based on the PNG
9819 memory source, but we have to provide a lot of extra functions.
9820 Blah.
63448a4d
WP		 9821
9822 We really only need to implement read and seek, but I am not
9823 convinced that the TIFF library is smart enough not to destroy
9824 itself if we only hand it the function pointers we need to
5ad6a5fb
GM		 9825 override. */
9826
9827typedef struct
9828{
63448a4d
WP		 9829 unsigned char *bytes;
9830 size_t len;
9831 int index;
5ad6a5fb
GM		 9832}
9833tiff_memory_source;
63448a4d 9834
e3130015 9835
5ad6a5fb
GM		 9836static size_t
9837tiff_read_from_memory (data, buf, size)
9838 thandle_t data;
9839 tdata_t buf;
9840 tsize_t size;
63448a4d 9841{
5ad6a5fb 9842 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP		 9843
9844 if (size > src->len - src->index)
5ad6a5fb
GM		 9845 return (size_t) -1;
9846 bcopy (src->bytes + src->index, buf, size);
63448a4d
WP		 9847 src->index += size;
9848 return size;
9849}
9850
e3130015 9851
5ad6a5fb
GM		 9852static size_t
9853tiff_write_from_memory (data, buf, size)
9854 thandle_t data;
9855 tdata_t buf;
9856 tsize_t size;
63448a4d
WP		 9857{
9858 return (size_t) -1;
9859}
9860
e3130015 9861
5ad6a5fb
GM		 9862static toff_t
9863tiff_seek_in_memory (data, off, whence)
9864 thandle_t data;
9865 toff_t off;
9866 int whence;
63448a4d 9867{
5ad6a5fb 9868 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP		 9869 int idx;
9870
9871 switch (whence)
5ad6a5fb
GM		 9872 {
9873 case SEEK_SET: /* Go from beginning of source. */
9874 idx = off;
9875 break;
488dd4c4 9876
5ad6a5fb
GM		 9877 case SEEK_END: /* Go from end of source. */
9878 idx = src->len + off;
9879 break;
488dd4c4 9880
5ad6a5fb
GM		 9881 case SEEK_CUR: /* Go from current position. */
9882 idx = src->index + off;
9883 break;
488dd4c4 9884
5ad6a5fb
GM		 9885 default: /* Invalid `whence'. */
9886 return -1;
9887 }
488dd4c4 9888
5ad6a5fb
GM		 9889 if (idx > src->len || idx < 0)
9890 return -1;
488dd4c4 9891
63448a4d
WP		 9892 src->index = idx;
9893 return src->index;
9894}
9895
e3130015 9896
5ad6a5fb
GM		 9897static int
9898tiff_close_memory (data)
9899 thandle_t data;
63448a4d
WP		 9900{
9901 /* NOOP */
5ad6a5fb 9902 return 0;
63448a4d
WP		 9903}
9904
e3130015 9905
5ad6a5fb
GM		 9906static int
9907tiff_mmap_memory (data, pbase, psize)
9908 thandle_t data;
9909 tdata_t *pbase;
9910 toff_t *psize;
63448a4d
WP		 9911{
9912 /* It is already _IN_ memory. */
5ad6a5fb 9913 return 0;
63448a4d
WP		 9914}
9915
e3130015 9916
5ad6a5fb
GM		 9917static void
9918tiff_unmap_memory (data, base, size)
9919 thandle_t data;
9920 tdata_t base;
9921 toff_t size;
63448a4d
WP		 9922{
9923 /* We don't need to do this. */
63448a4d
WP		 9924}
9925
e3130015 9926
5ad6a5fb
GM		 9927static toff_t
9928tiff_size_of_memory (data)
9929 thandle_t data;
63448a4d 9930{
5ad6a5fb 9931 return ((tiff_memory_source *) data)->len;
63448a4d 9932}
333b20bb 9933
e3130015 9934
c6892044
GM		 9935static void
9936tiff_error_handler (title, format, ap)
9937 const char *title, *format;
9938 va_list ap;
9939{
9940 char buf[512];
9941 int len;
488dd4c4 9942
c6892044
GM		 9943 len = sprintf (buf, "TIFF error: %s ", title);
9944 vsprintf (buf + len, format, ap);
9945 add_to_log (buf, Qnil, Qnil);
9946}
9947
9948
9949static void
9950tiff_warning_handler (title, format, ap)
9951 const char *title, *format;
9952 va_list ap;
9953{
9954 char buf[512];
9955 int len;
488dd4c4 9956
c6892044
GM		 9957 len = sprintf (buf, "TIFF warning: %s ", title);
9958 vsprintf (buf + len, format, ap);
9959 add_to_log (buf, Qnil, Qnil);
9960}
9961
9962
333b20bb
GM		 9963/* Load TIFF image IMG for use on frame F. Value is non-zero if
9964 successful. */
9965
9966static int
9967tiff_load (f, img)
9968 struct frame *f;
9969 struct image *img;
9970{
9971 Lisp_Object file, specified_file;
63448a4d 9972 Lisp_Object specified_data;
333b20bb
GM		 9973 TIFF *tiff;
9974 int width, height, x, y;
9975 uint32 *buf;
9976 int rc;
9977 XImage *ximg;
9978 struct gcpro gcpro1;
63448a4d 9979 tiff_memory_source memsrc;
333b20bb
GM		 9980
9981 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9982 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9983 file = Qnil;
9984 GCPRO1 (file);
63448a4d 9985
c6892044
GM		 9986 TIFFSetErrorHandler (tiff_error_handler);
9987 TIFFSetWarningHandler (tiff_warning_handler);
9988
63448a4d 9989 if (NILP (specified_data))
5ad6a5fb
GM		 9990 {
9991 /* Read from a file */
9992 file = x_find_image_file (specified_file);
9993 if (!STRINGP (file))
63448a4d 9994 {
45158a91 9995 image_error ("Cannot find image file `%s'", file, Qnil);
5ad6a5fb
GM		 9996 UNGCPRO;
9997 return 0;
9998 }
488dd4c4 9999
5ad6a5fb 10000 /* Try to open the image file. */
d5db4077 10001 tiff = TIFFOpen (SDATA (file), "r");
5ad6a5fb
GM		 10002 if (tiff == NULL)
10003 {
10004 image_error ("Cannot open `%s'", file, Qnil);
10005 UNGCPRO;
10006 return 0;
63448a4d 10007 }
5ad6a5fb 10008 }
63448a4d 10009 else
5ad6a5fb
GM		 10010 {
10011 /* Memory source! */
d5db4077
KR		 10012 memsrc.bytes = SDATA (specified_data);
10013 memsrc.len = SBYTES (specified_data);
5ad6a5fb
GM		 10014 memsrc.index = 0;
10015
10016 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
10017 (TIFFReadWriteProc) tiff_read_from_memory,
10018 (TIFFReadWriteProc) tiff_write_from_memory,
10019 tiff_seek_in_memory,
10020 tiff_close_memory,
10021 tiff_size_of_memory,
10022 tiff_mmap_memory,
10023 tiff_unmap_memory);
10024
10025 if (!tiff)
63448a4d 10026 {
45158a91 10027 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
5ad6a5fb
GM		 10028 UNGCPRO;
10029 return 0;
63448a4d 10030 }
5ad6a5fb 10031 }
333b20bb
GM		 10032
10033 /* Get width and height of the image, and allocate a raster buffer
10034 of width x height 32-bit values. */
10035 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
10036 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
10037 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
488dd4c4 10038
333b20bb
GM		 10039 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
10040 TIFFClose (tiff);
10041 if (!rc)
10042 {
45158a91 10043 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
333b20bb
GM		 10044 xfree (buf);
10045 UNGCPRO;
10046 return 0;
10047 }
10048
333b20bb 10049 /* Create the X image and pixmap. */
45158a91 10050 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 10051 {
333b20bb
GM		 10052 xfree (buf);
10053 UNGCPRO;
10054 return 0;
10055 }
10056
10057 /* Initialize the color table. */
10058 init_color_table ();
10059
10060 /* Process the pixel raster. Origin is in the lower-left corner. */
10061 for (y = 0; y < height; ++y)
10062 {
10063 uint32 *row = buf + y * width;
488dd4c4 10064
333b20bb
GM		 10065 for (x = 0; x < width; ++x)
10066 {
10067 uint32 abgr = row[x];
10068 int r = TIFFGetR (abgr) << 8;
10069 int g = TIFFGetG (abgr) << 8;
10070 int b = TIFFGetB (abgr) << 8;
488dd4c4 10071 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
333b20bb
GM		 10072 }
10073 }
10074
10075 /* Remember the colors allocated for the image. Free the color table. */
10076 img->colors = colors_in_color_table (&img->ncolors);
10077 free_color_table ();
488dd4c4 10078
f20a3b7a
MB		 10079 img->width = width;
10080 img->height = height;
10081
10082 /* Maybe fill in the background field while we have ximg handy. */
10083 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
10084 IMAGE_BACKGROUND (img, f, ximg);
333b20bb
GM		 10085
10086 /* Put the image into the pixmap, then free the X image and its buffer. */
10087 x_put_x_image (f, ximg, img->pixmap, width, height);
10088 x_destroy_x_image (ximg);
10089 xfree (buf);
333b20bb
GM		 10090
10091 UNGCPRO;
10092 return 1;
10093}
10094
10095#endif /* HAVE_TIFF != 0 */
10096
10097
10098\f
10099/***********************************************************************
10100 GIF
10101 ***********************************************************************/
10102
10103#if HAVE_GIF
10104
10105#include <gif_lib.h>
10106
10107static int gif_image_p P_ ((Lisp_Object object));
10108static int gif_load P_ ((struct frame *f, struct image *img));
10109
10110/* The symbol `gif' identifying images of this type. */
10111
10112Lisp_Object Qgif;
10113
10114/* Indices of image specification fields in gif_format, below. */
10115
10116enum gif_keyword_index
10117{
10118 GIF_TYPE,
63448a4d 10119 GIF_DATA,
333b20bb
GM		 10120 GIF_FILE,
10121 GIF_ASCENT,
10122 GIF_MARGIN,
10123 GIF_RELIEF,
10124 GIF_ALGORITHM,
10125 GIF_HEURISTIC_MASK,
4a8e312c 10126 GIF_MASK,
333b20bb 10127 GIF_IMAGE,
f20a3b7a 10128 GIF_BACKGROUND,
333b20bb
GM		 10129 GIF_LAST
10130};
10131
10132/* Vector of image_keyword structures describing the format
10133 of valid user-defined image specifications. */
10134
10135static struct image_keyword gif_format[GIF_LAST] =
10136{
10137 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 10138 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 10139 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 10140 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 10141 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 10142 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 10143 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 10144 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 10145 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f2f0a644 10146 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
f20a3b7a 10147 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 10148};
10149
10150/* Structure describing the image type `gif'. */
10151
10152static struct image_type gif_type =
10153{
10154 &Qgif,
10155 gif_image_p,
10156 gif_load,
10157 x_clear_image,
10158 NULL
10159};
10160
e3130015 10161
333b20bb
GM		 10162/* Return non-zero if OBJECT is a valid GIF image specification. */
10163
10164static int
10165gif_image_p (object)
10166 Lisp_Object object;
10167{
10168 struct image_keyword fmt[GIF_LAST];
10169 bcopy (gif_format, fmt, sizeof fmt);
488dd4c4 10170
7c7ff7f5 10171 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
333b20bb 10172 return 0;
488dd4c4 10173
63cec32f
GM		 10174 /* Must specify either the :data or :file keyword. */
10175 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
333b20bb
GM		 10176}
10177
e3130015 10178
63448a4d
WP		 10179/* Reading a GIF image from memory
10180 Based on the PNG memory stuff to a certain extent. */
10181
5ad6a5fb
GM		 10182typedef struct
10183{
63448a4d
WP		 10184 unsigned char *bytes;
10185 size_t len;
10186 int index;
5ad6a5fb
GM		 10187}
10188gif_memory_source;
63448a4d 10189
e3130015 10190
f036834a
GM		 10191/* Make the current memory source available to gif_read_from_memory.
10192 It's done this way because not all versions of libungif support
10193 a UserData field in the GifFileType structure. */
10194static gif_memory_source *current_gif_memory_src;
10195
5ad6a5fb
GM		 10196static int
10197gif_read_from_memory (file, buf, len)
10198 GifFileType *file;
10199 GifByteType *buf;
10200 int len;
63448a4d 10201{
f036834a 10202 gif_memory_source *src = current_gif_memory_src;
63448a4d 10203
5ad6a5fb
GM		 10204 if (len > src->len - src->index)
10205 return -1;
63448a4d 10206
5ad6a5fb 10207 bcopy (src->bytes + src->index, buf, len);
63448a4d
WP		 10208 src->index += len;
10209 return len;
10210}
333b20bb 10211
5ad6a5fb 10212
333b20bb
GM		 10213/* Load GIF image IMG for use on frame F. Value is non-zero if
10214 successful. */
10215
10216static int
10217gif_load (f, img)
10218 struct frame *f;
10219 struct image *img;
10220{
10221 Lisp_Object file, specified_file;
63448a4d 10222 Lisp_Object specified_data;
333b20bb
GM		 10223 int rc, width, height, x, y, i;
10224 XImage *ximg;
10225 ColorMapObject *gif_color_map;
10226 unsigned long pixel_colors[256];
10227 GifFileType *gif;
10228 struct gcpro gcpro1;
10229 Lisp_Object image;
10230 int ino, image_left, image_top, image_width, image_height;
63448a4d 10231 gif_memory_source memsrc;
9b784e96 10232 unsigned char *raster;
333b20bb
GM		 10233
10234 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 10235 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 10236 file = Qnil;
10237 GCPRO1 (file);
63448a4d
WP		 10238
10239 if (NILP (specified_data))
5ad6a5fb
GM		 10240 {
10241 file = x_find_image_file (specified_file);
10242 if (!STRINGP (file))
63448a4d 10243 {
45158a91 10244 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM		 10245 UNGCPRO;
10246 return 0;
10247 }
488dd4c4 10248
5ad6a5fb 10249 /* Open the GIF file. */
d5db4077 10250 gif = DGifOpenFileName (SDATA (file));
5ad6a5fb
GM		 10251 if (gif == NULL)
10252 {
10253 image_error ("Cannot open `%s'", file, Qnil);
10254 UNGCPRO;
10255 return 0;
63448a4d 10256 }
5ad6a5fb 10257 }
63448a4d 10258 else
5ad6a5fb
GM		 10259 {
10260 /* Read from memory! */
f036834a 10261 current_gif_memory_src = &memsrc;
d5db4077
KR		 10262 memsrc.bytes = SDATA (specified_data);
10263 memsrc.len = SBYTES (specified_data);
5ad6a5fb 10264 memsrc.index = 0;
63448a4d 10265
5ad6a5fb
GM		 10266 gif = DGifOpen(&memsrc, gif_read_from_memory);
10267 if (!gif)
10268 {
45158a91 10269 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
5ad6a5fb
GM		 10270 UNGCPRO;
10271 return 0;
63448a4d 10272 }
5ad6a5fb 10273 }
333b20bb
GM		 10274
10275 /* Read entire contents. */
10276 rc = DGifSlurp (gif);
10277 if (rc == GIF_ERROR)
10278 {
45158a91 10279 image_error ("Error reading `%s'", img->spec, Qnil);
333b20bb
GM		 10280 DGifCloseFile (gif);
10281 UNGCPRO;
10282 return 0;
10283 }
10284
3ccff1e3 10285 image = image_spec_value (img->spec, QCindex, NULL);
333b20bb
GM		 10286 ino = INTEGERP (image) ? XFASTINT (image) : 0;
10287 if (ino >= gif->ImageCount)
10288 {
45158a91
GM		 10289 image_error ("Invalid image number `%s' in image `%s'",
10290 image, img->spec);
333b20bb
GM		 10291 DGifCloseFile (gif);
10292 UNGCPRO;
10293 return 0;
10294 }
10295
c7f07c4c
PJ		 10296 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
10297 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
333b20bb 10298
333b20bb 10299 /* Create the X image and pixmap. */
45158a91 10300 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 10301 {
333b20bb
GM		 10302 DGifCloseFile (gif);
10303 UNGCPRO;
10304 return 0;
10305 }
488dd4c4 10306
333b20bb
GM		 10307 /* Allocate colors. */
10308 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
10309 if (!gif_color_map)
10310 gif_color_map = gif->SColorMap;
10311 init_color_table ();
10312 bzero (pixel_colors, sizeof pixel_colors);
488dd4c4 10313
333b20bb
GM		 10314 for (i = 0; i < gif_color_map->ColorCount; ++i)
10315 {
10316 int r = gif_color_map->Colors[i].Red << 8;
10317 int g = gif_color_map->Colors[i].Green << 8;
10318 int b = gif_color_map->Colors[i].Blue << 8;
10319 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
10320 }
10321
10322 img->colors = colors_in_color_table (&img->ncolors);
10323 free_color_table ();
10324
10325 /* Clear the part of the screen image that are not covered by
488dd4c4 10326 the image from the GIF file. Full animated GIF support
333b20bb
GM		 10327 requires more than can be done here (see the gif89 spec,
10328 disposal methods). Let's simply assume that the part
10329 not covered by a sub-image is in the frame's background color. */
10330 image_top = gif->SavedImages[ino].ImageDesc.Top;
10331 image_left = gif->SavedImages[ino].ImageDesc.Left;
10332 image_width = gif->SavedImages[ino].ImageDesc.Width;
10333 image_height = gif->SavedImages[ino].ImageDesc.Height;
10334
10335 for (y = 0; y < image_top; ++y)
10336 for (x = 0; x < width; ++x)
10337 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10338
10339 for (y = image_top + image_height; y < height; ++y)
10340 for (x = 0; x < width; ++x)
10341 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10342
10343 for (y = image_top; y < image_top + image_height; ++y)
10344 {
10345 for (x = 0; x < image_left; ++x)
10346 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10347 for (x = image_left + image_width; x < width; ++x)
10348 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10349 }
10350
9b784e96
GM		 10351 /* Read the GIF image into the X image. We use a local variable
10352 `raster' here because RasterBits below is a char *, and invites
10353 problems with bytes >= 0x80. */
10354 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
488dd4c4 10355
333b20bb
GM		 10356 if (gif->SavedImages[ino].ImageDesc.Interlace)
10357 {
10358 static int interlace_start[] = {0, 4, 2, 1};
10359 static int interlace_increment[] = {8, 8, 4, 2};
9b207e8e 10360 int pass;
06482119
GM		 10361 int row = interlace_start[0];
10362
10363 pass = 0;
333b20bb 10364
06482119 10365 for (y = 0; y < image_height; y++)
333b20bb 10366 {
06482119
GM		 10367 if (row >= image_height)
10368 {
10369 row = interlace_start[++pass];
10370 while (row >= image_height)
10371 row = interlace_start[++pass];
10372 }
488dd4c4 10373
06482119
GM		 10374 for (x = 0; x < image_width; x++)
10375 {
9b784e96 10376 int i = raster[(y * image_width) + x];
06482119
GM		 10377 XPutPixel (ximg, x + image_left, row + image_top,
10378 pixel_colors[i]);
10379 }
488dd4c4 10380
06482119 10381 row += interlace_increment[pass];
333b20bb
GM		 10382 }
10383 }
10384 else
10385 {
10386 for (y = 0; y < image_height; ++y)
10387 for (x = 0; x < image_width; ++x)
10388 {
9b784e96 10389 int i = raster[y * image_width + x];
333b20bb
GM		 10390 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
10391 }
10392 }
488dd4c4 10393
333b20bb 10394 DGifCloseFile (gif);
f20a3b7a
MB		 10395
10396 /* Maybe fill in the background field while we have ximg handy. */
10397 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
10398 IMAGE_BACKGROUND (img, f, ximg);
488dd4c4 10399
333b20bb
GM		 10400 /* Put the image into the pixmap, then free the X image and its buffer. */
10401 x_put_x_image (f, ximg, img->pixmap, width, height);
10402 x_destroy_x_image (ximg);
488dd4c4 10403
333b20bb
GM		 10404 UNGCPRO;
10405 return 1;
10406}
10407
10408#endif /* HAVE_GIF != 0 */
10409
10410
10411\f
10412/***********************************************************************
10413 Ghostscript
10414 ***********************************************************************/
10415
10416static int gs_image_p P_ ((Lisp_Object object));
10417static int gs_load P_ ((struct frame *f, struct image *img));
10418static void gs_clear_image P_ ((struct frame *f, struct image *img));
10419
fcf431dc 10420/* The symbol `postscript' identifying images of this type. */
333b20bb 10421
fcf431dc 10422Lisp_Object Qpostscript;
333b20bb
GM		 10423
10424/* Keyword symbols. */
10425
10426Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
10427
10428/* Indices of image specification fields in gs_format, below. */
10429
10430enum gs_keyword_index
10431{
10432 GS_TYPE,
10433 GS_PT_WIDTH,
10434 GS_PT_HEIGHT,
10435 GS_FILE,
10436 GS_LOADER,
10437 GS_BOUNDING_BOX,
10438 GS_ASCENT,
10439 GS_MARGIN,
10440 GS_RELIEF,
10441 GS_ALGORITHM,
10442 GS_HEURISTIC_MASK,
4a8e312c 10443 GS_MASK,
f20a3b7a 10444 GS_BACKGROUND,
333b20bb
GM		 10445 GS_LAST
10446};
10447
10448/* Vector of image_keyword structures describing the format
10449 of valid user-defined image specifications. */
10450
10451static struct image_keyword gs_format[GS_LAST] =
10452{
10453 {":type", IMAGE_SYMBOL_VALUE, 1},
10454 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
10455 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
10456 {":file", IMAGE_STRING_VALUE, 1},
10457 {":loader", IMAGE_FUNCTION_VALUE, 0},
10458 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
7c7ff7f5 10459 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 10460 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 10461 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 10462 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 10463 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
f20a3b7a
MB		 10464 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10465 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 10466};
10467
10468/* Structure describing the image type `ghostscript'. */
10469
10470static struct image_type gs_type =
10471{
fcf431dc 10472 &Qpostscript,
333b20bb
GM		 10473 gs_image_p,
10474 gs_load,
10475 gs_clear_image,
10476 NULL
10477};
10478
10479
10480/* Free X resources of Ghostscript image IMG which is used on frame F. */
10481
10482static void
10483gs_clear_image (f, img)
10484 struct frame *f;
10485 struct image *img;
10486{
10487 /* IMG->data.ptr_val may contain a recorded colormap. */
10488 xfree (img->data.ptr_val);
10489 x_clear_image (f, img);
10490}
10491
10492
10493/* Return non-zero if OBJECT is a valid Ghostscript image
10494 specification. */
10495
10496static int
10497gs_image_p (object)
10498 Lisp_Object object;
10499{
10500 struct image_keyword fmt[GS_LAST];
10501 Lisp_Object tem;
10502 int i;
488dd4c4 10503
333b20bb 10504 bcopy (gs_format, fmt, sizeof fmt);
488dd4c4 10505
7c7ff7f5 10506 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
333b20bb
GM		 10507 return 0;
10508
10509 /* Bounding box must be a list or vector containing 4 integers. */
10510 tem = fmt[GS_BOUNDING_BOX].value;
10511 if (CONSP (tem))
10512 {
10513 for (i = 0; i < 4; ++i, tem = XCDR (tem))
10514 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
10515 return 0;
10516 if (!NILP (tem))
10517 return 0;
10518 }
10519 else if (VECTORP (tem))
10520 {
10521 if (XVECTOR (tem)->size != 4)
10522 return 0;
10523 for (i = 0; i < 4; ++i)
10524 if (!INTEGERP (XVECTOR (tem)->contents[i]))
10525 return 0;
10526 }
10527 else
10528 return 0;
10529
10530 return 1;
10531}
10532
10533
10534/* Load Ghostscript image IMG for use on frame F. Value is non-zero
10535 if successful. */
10536
10537static int
10538gs_load (f, img)
10539 struct frame *f;
10540 struct image *img;
10541{
10542 char buffer[100];
10543 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
10544 struct gcpro gcpro1, gcpro2;
10545 Lisp_Object frame;
10546 double in_width, in_height;
10547 Lisp_Object pixel_colors = Qnil;
10548
10549 /* Compute pixel size of pixmap needed from the given size in the
10550 image specification. Sizes in the specification are in pt. 1 pt
10551 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10552 info. */
10553 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
10554 in_width = XFASTINT (pt_width) / 72.0;
10555 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
10556 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
10557 in_height = XFASTINT (pt_height) / 72.0;
10558 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
10559
10560 /* Create the pixmap. */
dd00328a 10561 xassert (img->pixmap == None);
333b20bb
GM		 10562 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10563 img->width, img->height,
10564 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
333b20bb
GM		 10565
10566 if (!img->pixmap)
10567 {
45158a91 10568 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
333b20bb
GM		 10569 return 0;
10570 }
488dd4c4 10571
333b20bb
GM		 10572 /* Call the loader to fill the pixmap. It returns a process object
10573 if successful. We do not record_unwind_protect here because
10574 other places in redisplay like calling window scroll functions
10575 don't either. Let the Lisp loader use `unwind-protect' instead. */
10576 GCPRO2 (window_and_pixmap_id, pixel_colors);
10577
10578 sprintf (buffer, "%lu %lu",
10579 (unsigned long) FRAME_X_WINDOW (f),
10580 (unsigned long) img->pixmap);
10581 window_and_pixmap_id = build_string (buffer);
488dd4c4 10582
333b20bb
GM		 10583 sprintf (buffer, "%lu %lu",
10584 FRAME_FOREGROUND_PIXEL (f),
10585 FRAME_BACKGROUND_PIXEL (f));
10586 pixel_colors = build_string (buffer);
488dd4c4 10587
333b20bb
GM		 10588 XSETFRAME (frame, f);
10589 loader = image_spec_value (img->spec, QCloader, NULL);
10590 if (NILP (loader))
10591 loader = intern ("gs-load-image");
10592
10593 img->data.lisp_val = call6 (loader, frame, img->spec,
10594 make_number (img->width),
10595 make_number (img->height),
10596 window_and_pixmap_id,
10597 pixel_colors);
10598 UNGCPRO;
10599 return PROCESSP (img->data.lisp_val);
10600}
10601
10602
10603/* Kill the Ghostscript process that was started to fill PIXMAP on
10604 frame F. Called from XTread_socket when receiving an event
10605 telling Emacs that Ghostscript has finished drawing. */
10606
10607void
10608x_kill_gs_process (pixmap, f)
10609 Pixmap pixmap;
10610 struct frame *f;
10611{
10612 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
10613 int class, i;
10614 struct image *img;
10615
10616 /* Find the image containing PIXMAP. */
10617 for (i = 0; i < c->used; ++i)
10618 if (c->images[i]->pixmap == pixmap)
10619 break;
10620
daba7643
GM		 10621 /* Should someone in between have cleared the image cache, for
10622 instance, give up. */
10623 if (i == c->used)
10624 return;
488dd4c4 10625
333b20bb
GM		 10626 /* Kill the GS process. We should have found PIXMAP in the image
10627 cache and its image should contain a process object. */
333b20bb
GM		 10628 img = c->images[i];
10629 xassert (PROCESSP (img->data.lisp_val));
10630 Fkill_process (img->data.lisp_val, Qnil);
10631 img->data.lisp_val = Qnil;
10632
10633 /* On displays with a mutable colormap, figure out the colors
10634 allocated for the image by looking at the pixels of an XImage for
10635 img->pixmap. */
383d6ffc 10636 class = FRAME_X_VISUAL (f)->class;
333b20bb
GM		 10637 if (class != StaticColor && class != StaticGray && class != TrueColor)
10638 {
10639 XImage *ximg;
10640
10641 BLOCK_INPUT;
10642
10643 /* Try to get an XImage for img->pixmep. */
10644 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
10645 0, 0, img->width, img->height, ~0, ZPixmap);
10646 if (ximg)
10647 {
10648 int x, y;
488dd4c4 10649
333b20bb
GM		 10650 /* Initialize the color table. */
10651 init_color_table ();
488dd4c4 10652
333b20bb
GM		 10653 /* For each pixel of the image, look its color up in the
10654 color table. After having done so, the color table will
10655 contain an entry for each color used by the image. */
10656 for (y = 0; y < img->height; ++y)
10657 for (x = 0; x < img->width; ++x)
10658 {
10659 unsigned long pixel = XGetPixel (ximg, x, y);
10660 lookup_pixel_color (f, pixel);
10661 }
10662
10663 /* Record colors in the image. Free color table and XImage. */
10664 img->colors = colors_in_color_table (&img->ncolors);
10665 free_color_table ();
10666 XDestroyImage (ximg);
10667
10668#if 0 /* This doesn't seem to be the case. If we free the colors
10669 here, we get a BadAccess later in x_clear_image when
10670 freeing the colors. */
10671 /* We have allocated colors once, but Ghostscript has also
10672 allocated colors on behalf of us. So, to get the
10673 reference counts right, free them once. */
10674 if (img->ncolors)
462d5d40 10675 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM		 10676#endif
10677 }
10678 else
10679 image_error ("Cannot get X image of `%s'; colors will not be freed",
45158a91 10680 img->spec, Qnil);
488dd4c4 10681
333b20bb
GM		 10682 UNBLOCK_INPUT;
10683 }
ad18ffb1
GM		 10684
10685 /* Now that we have the pixmap, compute mask and transform the
10686 image if requested. */
10687 BLOCK_INPUT;
10688 postprocess_image (f, img);
10689 UNBLOCK_INPUT;
333b20bb
GM		 10690}
10691
10692
10693\f
10694/***********************************************************************
10695 Window properties
10696 ***********************************************************************/
10697
10698DEFUN ("x-change-window-property", Fx_change_window_property,
10699 Sx_change_window_property, 2, 3, 0,
7ee72033 10700 doc: /* Change window property PROP to VALUE on the X window of FRAME.
c061c855 10701PROP and VALUE must be strings. FRAME nil or omitted means use the
7ee72033
MB		 10702selected frame. Value is VALUE. */)
10703 (prop, value, frame)
333b20bb
GM		 10704 Lisp_Object frame, prop, value;
10705{
10706 struct frame *f = check_x_frame (frame);
10707 Atom prop_atom;
10708
b7826503
PJ		 10709 CHECK_STRING (prop);
10710 CHECK_STRING (value);
333b20bb
GM		 10711
10712 BLOCK_INPUT;
d5db4077 10713 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
333b20bb
GM		 10714 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10715 prop_atom, XA_STRING, 8, PropModeReplace,
d5db4077 10716 SDATA (value), SCHARS (value));
333b20bb
GM		 10717
10718 /* Make sure the property is set when we return. */
10719 XFlush (FRAME_X_DISPLAY (f));
10720 UNBLOCK_INPUT;
10721
10722 return value;
10723}
10724
10725
10726DEFUN ("x-delete-window-property", Fx_delete_window_property,
10727 Sx_delete_window_property, 1, 2, 0,
7ee72033
MB		 10728 doc: /* Remove window property PROP from X window of FRAME.
10729FRAME nil or omitted means use the selected frame. Value is PROP. */)
10730 (prop, frame)
333b20bb
GM		 10731 Lisp_Object prop, frame;
10732{
10733 struct frame *f = check_x_frame (frame);
10734 Atom prop_atom;
10735
b7826503 10736 CHECK_STRING (prop);
333b20bb 10737 BLOCK_INPUT;
d5db4077 10738 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
333b20bb
GM		 10739 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
10740
10741 /* Make sure the property is removed when we return. */
10742 XFlush (FRAME_X_DISPLAY (f));
10743 UNBLOCK_INPUT;
10744
10745 return prop;
10746}
10747
10748
10749DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
10750 1, 2, 0,
7ee72033 10751 doc: /* Value is the value of window property PROP on FRAME.
c061c855
GM		 10752If FRAME is nil or omitted, use the selected frame. Value is nil
10753if FRAME hasn't a property with name PROP or if PROP has no string
7ee72033
MB		 10754value. */)
10755 (prop, frame)
333b20bb
GM		 10756 Lisp_Object prop, frame;
10757{
10758 struct frame *f = check_x_frame (frame);
10759 Atom prop_atom;
10760 int rc;
10761 Lisp_Object prop_value = Qnil;
10762 char *tmp_data = NULL;
10763 Atom actual_type;
10764 int actual_format;
10765 unsigned long actual_size, bytes_remaining;
10766
b7826503 10767 CHECK_STRING (prop);
333b20bb 10768 BLOCK_INPUT;
d5db4077 10769 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
333b20bb
GM		 10770 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10771 prop_atom, 0, 0, False, XA_STRING,
10772 &actual_type, &actual_format, &actual_size,
10773 &bytes_remaining, (unsigned char **) &tmp_data);
10774 if (rc == Success)
10775 {
10776 int size = bytes_remaining;
10777
10778 XFree (tmp_data);
10779 tmp_data = NULL;
10780
10781 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10782 prop_atom, 0, bytes_remaining,
10783 False, XA_STRING,
488dd4c4
JD		 10784 &actual_type, &actual_format,
10785 &actual_size, &bytes_remaining,
333b20bb 10786 (unsigned char **) &tmp_data);
4c8c7926 10787 if (rc == Success && tmp_data)
333b20bb
GM		 10788 prop_value = make_string (tmp_data, size);
10789
10790 XFree (tmp_data);
10791 }
10792
10793 UNBLOCK_INPUT;
10794 return prop_value;
10795}
10796
10797
10798\f
10799/***********************************************************************
10800 Busy cursor
10801 ***********************************************************************/
10802
4ae9a85e 10803/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 10804 an hourglass cursor on all frames. */
333b20bb 10805
0af913d7 10806static struct atimer *hourglass_atimer;
333b20bb 10807
0af913d7 10808/* Non-zero means an hourglass cursor is currently shown. */
333b20bb 10809
0af913d7 10810static int hourglass_shown_p;
333b20bb 10811
0af913d7 10812/* Number of seconds to wait before displaying an hourglass cursor. */
333b20bb 10813
0af913d7 10814static Lisp_Object Vhourglass_delay;
333b20bb 10815
0af913d7 10816/* Default number of seconds to wait before displaying an hourglass
4ae9a85e
GM		 10817 cursor. */
10818
0af913d7 10819#define DEFAULT_HOURGLASS_DELAY 1
4ae9a85e
GM		 10820
10821/* Function prototypes. */
10822
0af913d7
GM		 10823static void show_hourglass P_ ((struct atimer *));
10824static void hide_hourglass P_ ((void));
4ae9a85e
GM		 10825
10826
0af913d7 10827/* Cancel a currently active hourglass timer, and start a new one. */
4ae9a85e
GM		 10828
10829void
0af913d7 10830start_hourglass ()
333b20bb 10831{
4ae9a85e 10832 EMACS_TIME delay;
3caa99d3 10833 int secs, usecs = 0;
488dd4c4 10834
0af913d7 10835 cancel_hourglass ();
4ae9a85e 10836
0af913d7
GM		 10837 if (INTEGERP (Vhourglass_delay)
10838 && XINT (Vhourglass_delay) > 0)
10839 secs = XFASTINT (Vhourglass_delay);
10840 else if (FLOATP (Vhourglass_delay)
10841 && XFLOAT_DATA (Vhourglass_delay) > 0)
3caa99d3
GM		 10842 {
10843 Lisp_Object tem;
0af913d7 10844 tem = Ftruncate (Vhourglass_delay, Qnil);
3caa99d3 10845 secs = XFASTINT (tem);
0af913d7 10846 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
3caa99d3 10847 }
4ae9a85e 10848 else
0af913d7 10849 secs = DEFAULT_HOURGLASS_DELAY;
488dd4c4 10850
3caa99d3 10851 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 10852 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
10853 show_hourglass, NULL);
4ae9a85e
GM		 10854}
10855
10856
0af913d7 10857/* Cancel the hourglass cursor timer if active, hide a busy cursor if
4ae9a85e
GM		 10858 shown. */
10859
10860void
0af913d7 10861cancel_hourglass ()
4ae9a85e 10862{
0af913d7 10863 if (hourglass_atimer)
99f01f62 10864 {
0af913d7
GM		 10865 cancel_atimer (hourglass_atimer);
10866 hourglass_atimer = NULL;
99f01f62 10867 }
488dd4c4 10868
0af913d7
GM		 10869 if (hourglass_shown_p)
10870 hide_hourglass ();
4ae9a85e
GM		 10871}
10872
10873
0af913d7
GM		 10874/* Timer function of hourglass_atimer. TIMER is equal to
10875 hourglass_atimer.
4ae9a85e 10876
0af913d7
GM		 10877 Display an hourglass pointer on all frames by mapping the frames'
10878 hourglass_window. Set the hourglass_p flag in the frames'
10879 output_data.x structure to indicate that an hourglass cursor is
10880 shown on the frames. */
4ae9a85e
GM		 10881
10882static void
0af913d7 10883show_hourglass (timer)
4ae9a85e
GM		 10884 struct atimer *timer;
10885{
10886 /* The timer implementation will cancel this timer automatically
0af913d7 10887 after this function has run. Set hourglass_atimer to null
4ae9a85e 10888 so that we know the timer doesn't have to be canceled. */
0af913d7 10889 hourglass_atimer = NULL;
4ae9a85e 10890
0af913d7 10891 if (!hourglass_shown_p)
333b20bb
GM		 10892 {
10893 Lisp_Object rest, frame;
488dd4c4 10894
4ae9a85e 10895 BLOCK_INPUT;
488dd4c4 10896
333b20bb 10897 FOR_EACH_FRAME (rest, frame)
5f7a1890
GM		 10898 {
10899 struct frame *f = XFRAME (frame);
488dd4c4 10900
5f7a1890
GM		 10901 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
10902 {
10903 Display *dpy = FRAME_X_DISPLAY (f);
488dd4c4 10904
5f7a1890
GM		 10905#ifdef USE_X_TOOLKIT
10906 if (f->output_data.x->widget)
10907#else
10908 if (FRAME_OUTER_WINDOW (f))
10909#endif
10910 {
0af913d7 10911 f->output_data.x->hourglass_p = 1;
488dd4c4 10912
0af913d7 10913 if (!f->output_data.x->hourglass_window)
5f7a1890
GM		 10914 {
10915 unsigned long mask = CWCursor;
10916 XSetWindowAttributes attrs;
488dd4c4 10917
0af913d7 10918 attrs.cursor = f->output_data.x->hourglass_cursor;
488dd4c4 10919
0af913d7 10920 f->output_data.x->hourglass_window
5f7a1890
GM		 10921 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
10922 0, 0, 32000, 32000, 0, 0,
10923 InputOnly,
10924 CopyFromParent,
10925 mask, &attrs);
10926 }
488dd4c4 10927
0af913d7 10928 XMapRaised (dpy, f->output_data.x->hourglass_window);
5f7a1890
GM		 10929 XFlush (dpy);
10930 }
10931 }
10932 }
333b20bb 10933
0af913d7 10934 hourglass_shown_p = 1;
4ae9a85e
GM		 10935 UNBLOCK_INPUT;
10936 }
333b20bb
GM		 10937}
10938
10939
0af913d7
GM		 10940/* Hide the hourglass pointer on all frames, if it is currently
10941 shown. */
333b20bb 10942
4ae9a85e 10943static void
0af913d7 10944hide_hourglass ()
4ae9a85e 10945{
0af913d7 10946 if (hourglass_shown_p)
333b20bb 10947 {
4ae9a85e
GM		 10948 Lisp_Object rest, frame;
10949
10950 BLOCK_INPUT;
10951 FOR_EACH_FRAME (rest, frame)
333b20bb 10952 {
4ae9a85e 10953 struct frame *f = XFRAME (frame);
488dd4c4 10954
4ae9a85e
GM		 10955 if (FRAME_X_P (f)
10956 /* Watch out for newly created frames. */
0af913d7 10957 && f->output_data.x->hourglass_window)
4ae9a85e 10958 {
0af913d7
GM		 10959 XUnmapWindow (FRAME_X_DISPLAY (f),
10960 f->output_data.x->hourglass_window);
10961 /* Sync here because XTread_socket looks at the
10962 hourglass_p flag that is reset to zero below. */
4ae9a85e 10963 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 10964 f->output_data.x->hourglass_p = 0;
4ae9a85e 10965 }
333b20bb 10966 }
333b20bb 10967
0af913d7 10968 hourglass_shown_p = 0;
4ae9a85e
GM		 10969 UNBLOCK_INPUT;
10970 }
333b20bb
GM		 10971}
10972
10973
10974\f
10975/***********************************************************************
10976 Tool tips
10977 ***********************************************************************/
10978
10979static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
275841bf 10980 Lisp_Object, Lisp_Object));
06d62053 10981static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
ab452f99 10982 Lisp_Object, int, int, int *, int *));
488dd4c4 10983
44b5a125 10984/* The frame of a currently visible tooltip. */
333b20bb 10985
44b5a125 10986Lisp_Object tip_frame;
333b20bb
GM		 10987
10988/* If non-nil, a timer started that hides the last tooltip when it
10989 fires. */
10990
10991Lisp_Object tip_timer;
10992Window tip_window;
10993
06d62053
GM		 10994/* If non-nil, a vector of 3 elements containing the last args
10995 with which x-show-tip was called. See there. */
10996
10997Lisp_Object last_show_tip_args;
10998
d63931a2
GM		 10999/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
11000
11001Lisp_Object Vx_max_tooltip_size;
11002
eaf1eea9
GM		 11003
11004static Lisp_Object
11005unwind_create_tip_frame (frame)
11006 Lisp_Object frame;
11007{
c844a81a
GM		 11008 Lisp_Object deleted;
11009
11010 deleted = unwind_create_frame (frame);
11011 if (EQ (deleted, Qt))
11012 {
11013 tip_window = None;
11014 tip_frame = Qnil;
11015 }
488dd4c4 11016
c844a81a 11017 return deleted;
eaf1eea9
GM		 11018}
11019
11020
333b20bb 11021/* Create a frame for a tooltip on the display described by DPYINFO.
275841bf
GM		 11022 PARMS is a list of frame parameters. TEXT is the string to
11023 display in the tip frame. Value is the frame.
eaf1eea9
GM		 11024
11025 Note that functions called here, esp. x_default_parameter can
11026 signal errors, for instance when a specified color name is
11027 undefined. We have to make sure that we're in a consistent state
11028 when this happens. */
333b20bb
GM		 11029
11030static Lisp_Object
275841bf 11031x_create_tip_frame (dpyinfo, parms, text)
333b20bb 11032 struct x_display_info *dpyinfo;
275841bf 11033 Lisp_Object parms, text;
333b20bb
GM		 11034{
11035 struct frame *f;
11036 Lisp_Object frame, tem;
11037 Lisp_Object name;
333b20bb
GM		 11038 long window_prompting = 0;
11039 int width, height;
331379bf 11040 int count = SPECPDL_INDEX ();
b6d7acec 11041 struct gcpro gcpro1, gcpro2, gcpro3;
333b20bb 11042 struct kboard *kb;
06d62053 11043 int face_change_count_before = face_change_count;
275841bf
GM		 11044 Lisp_Object buffer;
11045 struct buffer *old_buffer;
333b20bb
GM		 11046
11047 check_x ();
11048
11049 /* Use this general default value to start with until we know if
11050 this frame has a specified name. */
11051 Vx_resource_name = Vinvocation_name;
11052
11053#ifdef MULTI_KBOARD
11054 kb = dpyinfo->kboard;
11055#else
11056 kb = &the_only_kboard;
11057#endif
11058
11059 /* Get the name of the frame to use for resource lookup. */
11060 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
11061 if (!STRINGP (name)
11062 && !EQ (name, Qunbound)
11063 && !NILP (name))
11064 error ("Invalid frame name--not a string or nil");
11065 Vx_resource_name = name;
11066
11067 frame = Qnil;
11068 GCPRO3 (parms, name, frame);
44b5a125 11069 f = make_frame (1);
333b20bb 11070 XSETFRAME (frame, f);
275841bf
GM		 11071
11072 buffer = Fget_buffer_create (build_string (" *tip*"));
11073 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
11074 old_buffer = current_buffer;
11075 set_buffer_internal_1 (XBUFFER (buffer));
d63931a2 11076 current_buffer->truncate_lines = Qnil;
275841bf
GM		 11077 Ferase_buffer ();
11078 Finsert (1, &text);
11079 set_buffer_internal_1 (old_buffer);
488dd4c4 11080
333b20bb 11081 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
8a1a7743 11082 record_unwind_protect (unwind_create_tip_frame, frame);
333b20bb 11083
eaf1eea9
GM		 11084 /* By setting the output method, we're essentially saying that
11085 the frame is live, as per FRAME_LIVE_P. If we get a signal
11086 from this point on, x_destroy_window might screw up reference
11087 counts etc. */
333b20bb
GM		 11088 f->output_method = output_x_window;
11089 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
11090 bzero (f->output_data.x, sizeof (struct x_output));
11091 f->output_data.x->icon_bitmap = -1;
11092 f->output_data.x->fontset = -1;
61d461a8
GM		 11093 f->output_data.x->scroll_bar_foreground_pixel = -1;
11094 f->output_data.x->scroll_bar_background_pixel = -1;
f15340b7
MB		 11095#ifdef USE_TOOLKIT_SCROLL_BARS
11096 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
11097 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
11098#endif /* USE_TOOLKIT_SCROLL_BARS */
333b20bb
GM		 11099 f->icon_name = Qnil;
11100 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 11101#if GLYPH_DEBUG
eaf1eea9
GM		 11102 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
11103 dpyinfo_refcount = dpyinfo->reference_count;
11104#endif /* GLYPH_DEBUG */
333b20bb
GM		 11105#ifdef MULTI_KBOARD
11106 FRAME_KBOARD (f) = kb;
11107#endif
11108 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
11109 f->output_data.x->explicit_parent = 0;
11110
61d461a8
GM		 11111 /* These colors will be set anyway later, but it's important
11112 to get the color reference counts right, so initialize them! */
11113 {
11114 Lisp_Object black;
11115 struct gcpro gcpro1;
488dd4c4 11116
61d461a8
GM		 11117 black = build_string ("black");
11118 GCPRO1 (black);
11119 f->output_data.x->foreground_pixel
11120 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
11121 f->output_data.x->background_pixel
11122 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
11123 f->output_data.x->cursor_pixel
11124 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
11125 f->output_data.x->cursor_foreground_pixel
11126 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
11127 f->output_data.x->border_pixel
11128 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
11129 f->output_data.x->mouse_pixel
11130 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
11131 UNGCPRO;
11132 }
11133
333b20bb
GM		 11134 /* Set the name; the functions to which we pass f expect the name to
11135 be set. */
11136 if (EQ (name, Qunbound) || NILP (name))
11137 {
11138 f->name = build_string (dpyinfo->x_id_name);
11139 f->explicit_name = 0;
11140 }
11141 else
11142 {
11143 f->name = name;
11144 f->explicit_name = 1;
11145 /* use the frame's title when getting resources for this frame. */
11146 specbind (Qx_resource_name, name);
11147 }
11148
eaf1eea9
GM		 11149 /* Extract the window parameters from the supplied values that are
11150 needed to determine window geometry. */
333b20bb
GM		 11151 {
11152 Lisp_Object font;
11153
11154 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
11155
11156 BLOCK_INPUT;
11157 /* First, try whatever font the caller has specified. */
11158 if (STRINGP (font))
11159 {
11160 tem = Fquery_fontset (font, Qnil);
11161 if (STRINGP (tem))
d5db4077 11162 font = x_new_fontset (f, SDATA (tem));
333b20bb 11163 else
d5db4077 11164 font = x_new_font (f, SDATA (font));
333b20bb 11165 }
488dd4c4 11166
333b20bb
GM		 11167 /* Try out a font which we hope has bold and italic variations. */
11168 if (!STRINGP (font))
11169 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11170 if (!STRINGP (font))
11171 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11172 if (! STRINGP (font))
11173 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11174 if (! STRINGP (font))
11175 /* This was formerly the first thing tried, but it finds too many fonts
11176 and takes too long. */
11177 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11178 /* If those didn't work, look for something which will at least work. */
11179 if (! STRINGP (font))
11180 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11181 UNBLOCK_INPUT;
11182 if (! STRINGP (font))
11183 font = build_string ("fixed");
11184
11185 x_default_parameter (f, parms, Qfont, font,
11186 "font", "Font", RES_TYPE_STRING);
11187 }
11188
11189 x_default_parameter (f, parms, Qborder_width, make_number (2),
11190 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
488dd4c4 11191
333b20bb
GM		 11192 /* This defaults to 2 in order to match xterm. We recognize either
11193 internalBorderWidth or internalBorder (which is what xterm calls
11194 it). */
11195 if (NILP (Fassq (Qinternal_border_width, parms)))
11196 {
11197 Lisp_Object value;
11198
11199 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
11200 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
11201 if (! EQ (value, Qunbound))
11202 parms = Fcons (Fcons (Qinternal_border_width, value),
11203 parms);
11204 }
11205
11206 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
11207 "internalBorderWidth", "internalBorderWidth",
11208 RES_TYPE_NUMBER);
11209
11210 /* Also do the stuff which must be set before the window exists. */
11211 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
11212 "foreground", "Foreground", RES_TYPE_STRING);
11213 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
11214 "background", "Background", RES_TYPE_STRING);
11215 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
11216 "pointerColor", "Foreground", RES_TYPE_STRING);
11217 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
11218 "cursorColor", "Foreground", RES_TYPE_STRING);
11219 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
11220 "borderColor", "BorderColor", RES_TYPE_STRING);
11221
11222 /* Init faces before x_default_parameter is called for scroll-bar
11223 parameters because that function calls x_set_scroll_bar_width,
11224 which calls change_frame_size, which calls Fset_window_buffer,
11225 which runs hooks, which call Fvertical_motion. At the end, we
11226 end up in init_iterator with a null face cache, which should not
11227 happen. */
11228 init_frame_faces (f);
488dd4c4 11229
333b20bb
GM		 11230 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
11231 window_prompting = x_figure_window_size (f, parms);
11232
11233 if (window_prompting & XNegative)
11234 {
11235 if (window_prompting & YNegative)
11236 f->output_data.x->win_gravity = SouthEastGravity;
11237 else
11238 f->output_data.x->win_gravity = NorthEastGravity;
11239 }
11240 else
11241 {
11242 if (window_prompting & YNegative)
11243 f->output_data.x->win_gravity = SouthWestGravity;
11244 else
11245 f->output_data.x->win_gravity = NorthWestGravity;
11246 }
11247
11248 f->output_data.x->size_hint_flags = window_prompting;
11249 {
11250 XSetWindowAttributes attrs;
11251 unsigned long mask;
488dd4c4 11252
333b20bb 11253 BLOCK_INPUT;
c51d2b5e
GM		 11254 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
11255 if (DoesSaveUnders (dpyinfo->screen))
11256 mask |= CWSaveUnder;
488dd4c4 11257
9b2956e2
GM		 11258 /* Window managers look at the override-redirect flag to determine
11259 whether or net to give windows a decoration (Xlib spec, chapter
333b20bb
GM		 11260 3.2.8). */
11261 attrs.override_redirect = True;
11262 attrs.save_under = True;
11263 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
11264 /* Arrange for getting MapNotify and UnmapNotify events. */
11265 attrs.event_mask = StructureNotifyMask;
11266 tip_window
11267 = FRAME_X_WINDOW (f)
11268 = XCreateWindow (FRAME_X_DISPLAY (f),
11269 FRAME_X_DISPLAY_INFO (f)->root_window,
11270 /* x, y, width, height */
11271 0, 0, 1, 1,
11272 /* Border. */
11273 1,
11274 CopyFromParent, InputOutput, CopyFromParent,
11275 mask, &attrs);
11276 UNBLOCK_INPUT;
11277 }
11278
11279 x_make_gc (f);
11280
333b20bb
GM		 11281 x_default_parameter (f, parms, Qauto_raise, Qnil,
11282 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11283 x_default_parameter (f, parms, Qauto_lower, Qnil,
11284 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11285 x_default_parameter (f, parms, Qcursor_type, Qbox,
11286 "cursorType", "CursorType", RES_TYPE_SYMBOL);
11287
11288 /* Dimensions, especially f->height, must be done via change_frame_size.
11289 Change will not be effected unless different from the current
11290 f->height. */
11291 width = f->width;
11292 height = f->height;
11293 f->height = 0;
11294 SET_FRAME_WIDTH (f, 0);
8938a4fb 11295 change_frame_size (f, height, width, 1, 0, 0);
488dd4c4 11296
cd1d850f
JPW		 11297 /* Add `tooltip' frame parameter's default value. */
11298 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
11299 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
11300 Qnil));
488dd4c4 11301
035d5114 11302 /* Set up faces after all frame parameters are known. This call
6801a572
GM		 11303 also merges in face attributes specified for new frames.
11304
11305 Frame parameters may be changed if .Xdefaults contains
11306 specifications for the default font. For example, if there is an
11307 `Emacs.default.attributeBackground: pink', the `background-color'
11308 attribute of the frame get's set, which let's the internal border
11309 of the tooltip frame appear in pink. Prevent this. */
11310 {
11311 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
11312
11313 /* Set tip_frame here, so that */
11314 tip_frame = frame;
11315 call1 (Qface_set_after_frame_default, frame);
488dd4c4 11316
6801a572
GM		 11317 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
11318 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
11319 Qnil));
11320 }
488dd4c4 11321
333b20bb
GM		 11322 f->no_split = 1;
11323
11324 UNGCPRO;
11325
11326 /* It is now ok to make the frame official even if we get an error
11327 below. And the frame needs to be on Vframe_list or making it
11328 visible won't work. */
11329 Vframe_list = Fcons (frame, Vframe_list);
11330
11331 /* Now that the frame is official, it counts as a reference to
11332 its display. */
11333 FRAME_X_DISPLAY_INFO (f)->reference_count++;
11334
06d62053
GM		 11335 /* Setting attributes of faces of the tooltip frame from resources
11336 and similar will increment face_change_count, which leads to the
11337 clearing of all current matrices. Since this isn't necessary
11338 here, avoid it by resetting face_change_count to the value it
11339 had before we created the tip frame. */
11340 face_change_count = face_change_count_before;
11341
eaf1eea9 11342 /* Discard the unwind_protect. */
333b20bb
GM		 11343 return unbind_to (count, frame);
11344}
11345
11346
06d62053
GM		 11347/* Compute where to display tip frame F. PARMS is the list of frame
11348 parameters for F. DX and DY are specified offsets from the current
ab452f99
GM		 11349 location of the mouse. WIDTH and HEIGHT are the width and height
11350 of the tooltip. Return coordinates relative to the root window of
11351 the display in *ROOT_X, and *ROOT_Y. */
06d62053
GM		 11352
11353static void
ab452f99 11354compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
06d62053
GM		 11355 struct frame *f;
11356 Lisp_Object parms, dx, dy;
ab452f99 11357 int width, height;
06d62053
GM		 11358 int *root_x, *root_y;
11359{
11360 Lisp_Object left, top;
11361 int win_x, win_y;
11362 Window root, child;
11363 unsigned pmask;
488dd4c4 11364
06d62053
GM		 11365 /* User-specified position? */
11366 left = Fcdr (Fassq (Qleft, parms));
11367 top = Fcdr (Fassq (Qtop, parms));
488dd4c4 11368
06d62053
GM		 11369 /* Move the tooltip window where the mouse pointer is. Resize and
11370 show it. */
570d22b0 11371 if (!INTEGERP (left) || !INTEGERP (top))
ab452f99
GM		 11372 {
11373 BLOCK_INPUT;
11374 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
11375 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
11376 UNBLOCK_INPUT;
11377 }
06d62053 11378
06d62053
GM		 11379 if (INTEGERP (top))
11380 *root_y = XINT (top);
ab452f99
GM		 11381 else if (*root_y + XINT (dy) - height < 0)
11382 *root_y -= XINT (dy);
11383 else
11384 {
11385 *root_y -= height;
11386 *root_y += XINT (dy);
11387 }
11388
11389 if (INTEGERP (left))
11390 *root_x = XINT (left);
d682d3df
RS		 11391 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
11392 /* It fits to the right of the pointer. */
11393 *root_x += XINT (dx);
11394 else if (width + XINT (dx) <= *root_x)
11395 /* It fits to the left of the pointer. */
ab452f99
GM		 11396 *root_x -= width + XINT (dx);
11397 else
d682d3df
RS		 11398 /* Put it left-justified on the screen--it ought to fit that way. */
11399 *root_x = 0;
06d62053
GM		 11400}
11401
11402
0634ce98 11403DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
7ee72033 11404 doc: /* Show STRING in a "tooltip" window on frame FRAME.
c061c855
GM		 11405A tooltip window is a small X window displaying a string.
11406
11407FRAME nil or omitted means use the selected frame.
11408
11409PARMS is an optional list of frame parameters which can be used to
11410change the tooltip's appearance.
11411
11412Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
11413means use the default timeout of 5 seconds.
11414
11415If the list of frame parameters PARAMS contains a `left' parameters,
11416the tooltip is displayed at that x-position. Otherwise it is
11417displayed at the mouse position, with offset DX added (default is 5 if
11418DX isn't specified). Likewise for the y-position; if a `top' frame
11419parameter is specified, it determines the y-position of the tooltip
11420window, otherwise it is displayed at the mouse position, with offset
11421DY added (default is -10).
11422
11423A tooltip's maximum size is specified by `x-max-tooltip-size'.
7ee72033
MB		 11424Text larger than the specified size is clipped. */)
11425 (string, frame, parms, timeout, dx, dy)
0634ce98 11426 Lisp_Object string, frame, parms, timeout, dx, dy;
333b20bb
GM		 11427{
11428 struct frame *f;
11429 struct window *w;
06d62053 11430 int root_x, root_y;
333b20bb
GM		 11431 struct buffer *old_buffer;
11432 struct text_pos pos;
11433 int i, width, height;
393f2d14 11434 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
333b20bb 11435 int old_windows_or_buffers_changed = windows_or_buffers_changed;
331379bf 11436 int count = SPECPDL_INDEX ();
488dd4c4 11437
333b20bb
GM		 11438 specbind (Qinhibit_redisplay, Qt);
11439
393f2d14 11440 GCPRO4 (string, parms, frame, timeout);
333b20bb 11441
b7826503 11442 CHECK_STRING (string);
333b20bb
GM		 11443 f = check_x_frame (frame);
11444 if (NILP (timeout))
11445 timeout = make_number (5);
11446 else
b7826503 11447 CHECK_NATNUM (timeout);
488dd4c4 11448
0634ce98
GM		 11449 if (NILP (dx))
11450 dx = make_number (5);
11451 else
b7826503 11452 CHECK_NUMBER (dx);
488dd4c4 11453
0634ce98 11454 if (NILP (dy))
12c67a7f 11455 dy = make_number (-10);
0634ce98 11456 else
b7826503 11457 CHECK_NUMBER (dy);
333b20bb 11458
06d62053
GM		 11459 if (NILP (last_show_tip_args))
11460 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
11461
11462 if (!NILP (tip_frame))
11463 {
11464 Lisp_Object last_string = AREF (last_show_tip_args, 0);
11465 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
11466 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
11467
11468 if (EQ (frame, last_frame)
11469 && !NILP (Fequal (last_string, string))
11470 && !NILP (Fequal (last_parms, parms)))
11471 {
11472 struct frame *f = XFRAME (tip_frame);
488dd4c4 11473
06d62053
GM		 11474 /* Only DX and DY have changed. */
11475 if (!NILP (tip_timer))
ae782866
GM		 11476 {
11477 Lisp_Object timer = tip_timer;
11478 tip_timer = Qnil;
11479 call1 (Qcancel_timer, timer);
11480 }
06d62053
GM		 11481
11482 BLOCK_INPUT;
ab452f99
GM		 11483 compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
11484 PIXEL_HEIGHT (f), &root_x, &root_y);
06d62053 11485 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11486 root_x, root_y);
06d62053
GM		 11487 UNBLOCK_INPUT;
11488 goto start_timer;
11489 }
11490 }
11491
333b20bb
GM		 11492 /* Hide a previous tip, if any. */
11493 Fx_hide_tip ();
11494
06d62053
GM		 11495 ASET (last_show_tip_args, 0, string);
11496 ASET (last_show_tip_args, 1, frame);
11497 ASET (last_show_tip_args, 2, parms);
11498
333b20bb
GM		 11499 /* Add default values to frame parameters. */
11500 if (NILP (Fassq (Qname, parms)))
11501 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
11502 if (NILP (Fassq (Qinternal_border_width, parms)))
11503 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
11504 if (NILP (Fassq (Qborder_width, parms)))
11505 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
11506 if (NILP (Fassq (Qborder_color, parms)))
11507 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
11508 if (NILP (Fassq (Qbackground_color, parms)))
11509 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
11510 parms);
11511
11512 /* Create a frame for the tooltip, and record it in the global
11513 variable tip_frame. */
275841bf 11514 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
44b5a125 11515 f = XFRAME (frame);
333b20bb 11516
d63931a2 11517 /* Set up the frame's root window. */
333b20bb
GM		 11518 w = XWINDOW (FRAME_ROOT_WINDOW (f));
11519 w->left = w->top = make_number (0);
488dd4c4 11520
d63931a2
GM		 11521 if (CONSP (Vx_max_tooltip_size)
11522 && INTEGERP (XCAR (Vx_max_tooltip_size))
11523 && XINT (XCAR (Vx_max_tooltip_size)) > 0
11524 && INTEGERP (XCDR (Vx_max_tooltip_size))
11525 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
11526 {
11527 w->width = XCAR (Vx_max_tooltip_size);
11528 w->height = XCDR (Vx_max_tooltip_size);
11529 }
11530 else
11531 {
11532 w->width = make_number (80);
11533 w->height = make_number (40);
11534 }
488dd4c4 11535
d63931a2 11536 f->window_width = XINT (w->width);
333b20bb
GM		 11537 adjust_glyphs (f);
11538 w->pseudo_window_p = 1;
11539
11540 /* Display the tooltip text in a temporary buffer. */
333b20bb 11541 old_buffer = current_buffer;
275841bf 11542 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
d63931a2 11543 current_buffer->truncate_lines = Qnil;
333b20bb
GM		 11544 clear_glyph_matrix (w->desired_matrix);
11545 clear_glyph_matrix (w->current_matrix);
11546 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
11547 try_window (FRAME_ROOT_WINDOW (f), pos);
11548
11549 /* Compute width and height of the tooltip. */
11550 width = height = 0;
11551 for (i = 0; i < w->desired_matrix->nrows; ++i)
11552 {
11553 struct glyph_row *row = &w->desired_matrix->rows[i];
11554 struct glyph *last;
11555 int row_width;
11556
11557 /* Stop at the first empty row at the end. */
11558 if (!row->enabled_p || !row->displays_text_p)
11559 break;
11560
d7bf0342
GM		 11561 /* Let the row go over the full width of the frame. */
11562 row->full_width_p = 1;
333b20bb 11563
e3130015 11564 /* There's a glyph at the end of rows that is used to place
333b20bb
GM		 11565 the cursor there. Don't include the width of this glyph. */
11566 if (row->used[TEXT_AREA])
11567 {
11568 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
11569 row_width = row->pixel_width - last->pixel_width;
11570 }
11571 else
11572 row_width = row->pixel_width;
488dd4c4 11573
333b20bb
GM		 11574 height += row->height;
11575 width = max (width, row_width);
11576 }
11577
11578 /* Add the frame's internal border to the width and height the X
11579 window should have. */
11580 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11581 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11582
11583 /* Move the tooltip window where the mouse pointer is. Resize and
11584 show it. */
ab452f99 11585 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
0634ce98 11586
0634ce98 11587 BLOCK_INPUT;
333b20bb 11588 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11589 root_x, root_y, width, height);
333b20bb
GM		 11590 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
11591 UNBLOCK_INPUT;
488dd4c4 11592
333b20bb
GM		 11593 /* Draw into the window. */
11594 w->must_be_updated_p = 1;
11595 update_single_window (w, 1);
11596
11597 /* Restore original current buffer. */
11598 set_buffer_internal_1 (old_buffer);
11599 windows_or_buffers_changed = old_windows_or_buffers_changed;
11600
06d62053 11601 start_timer:
333b20bb
GM		 11602 /* Let the tip disappear after timeout seconds. */
11603 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
11604 intern ("x-hide-tip"));
a744a2ec
DL		 11605
11606 UNGCPRO;
333b20bb
GM		 11607 return unbind_to (count, Qnil);
11608}
11609
11610
11611DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
7ee72033
MB		 11612 doc: /* Hide the current tooltip window, if there is any.
11613Value is t if tooltip was open, nil otherwise. */)
11614 ()
333b20bb 11615{
44b5a125 11616 int count;
c0006262
GM		 11617 Lisp_Object deleted, frame, timer;
11618 struct gcpro gcpro1, gcpro2;
44b5a125
GM		 11619
11620 /* Return quickly if nothing to do. */
c0006262 11621 if (NILP (tip_timer) && NILP (tip_frame))
44b5a125 11622 return Qnil;
488dd4c4 11623
c0006262
GM		 11624 frame = tip_frame;
11625 timer = tip_timer;
11626 GCPRO2 (frame, timer);
11627 tip_frame = tip_timer = deleted = Qnil;
488dd4c4 11628
331379bf 11629 count = SPECPDL_INDEX ();
333b20bb 11630 specbind (Qinhibit_redisplay, Qt);
44b5a125 11631 specbind (Qinhibit_quit, Qt);
488dd4c4 11632
c0006262 11633 if (!NILP (timer))
ae782866 11634 call1 (Qcancel_timer, timer);
333b20bb 11635
c0006262 11636 if (FRAMEP (frame))
333b20bb 11637 {
44b5a125
GM		 11638 Fdelete_frame (frame, Qnil);
11639 deleted = Qt;
f6c44811
GM		 11640
11641#ifdef USE_LUCID
11642 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11643 redisplay procedure is not called when a tip frame over menu
11644 items is unmapped. Redisplay the menu manually... */
11645 {
11646 struct frame *f = SELECTED_FRAME ();
11647 Widget w = f->output_data.x->menubar_widget;
11648 extern void xlwmenu_redisplay P_ ((Widget));
9180dc8c 11649
f6c44811 11650 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
dbc64aa7 11651 && w != NULL)
f6c44811
GM		 11652 {
11653 BLOCK_INPUT;
11654 xlwmenu_redisplay (w);
11655 UNBLOCK_INPUT;
11656 }
11657 }
11658#endif /* USE_LUCID */
333b20bb
GM		 11659 }
11660
c0006262 11661 UNGCPRO;
44b5a125 11662 return unbind_to (count, deleted);
333b20bb
GM		 11663}
11664
11665
11666\f
11667/***********************************************************************
11668 File selection dialog
11669 ***********************************************************************/
11670
11671#ifdef USE_MOTIF
11672
11673/* Callback for "OK" and "Cancel" on file selection dialog. */
11674
11675static void
11676file_dialog_cb (widget, client_data, call_data)
11677 Widget widget;
11678 XtPointer call_data, client_data;
11679{
11680 int *result = (int *) client_data;
11681 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
11682 *result = cb->reason;
11683}
11684
11685
a779d213
GM		 11686/* Callback for unmapping a file selection dialog. This is used to
11687 capture the case where a dialog is closed via a window manager's
11688 closer button, for example. Using a XmNdestroyCallback didn't work
11689 in this case. */
11690
11691static void
11692file_dialog_unmap_cb (widget, client_data, call_data)
11693 Widget widget;
11694 XtPointer call_data, client_data;
11695{
11696 int *result = (int *) client_data;
11697 *result = XmCR_CANCEL;
11698}
11699
11700
333b20bb 11701DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
7ee72033 11702 doc: /* Read file name, prompting with PROMPT in directory DIR.
c061c855
GM		 11703Use a file selection dialog.
11704Select DEFAULT-FILENAME in the dialog's file selection box, if
11705specified. Don't let the user enter a file name in the file
7ee72033
MB		 11706selection dialog's entry field, if MUSTMATCH is non-nil. */)
11707 (prompt, dir, default_filename, mustmatch)
333b20bb
GM		 11708 Lisp_Object prompt, dir, default_filename, mustmatch;
11709{
11710 int result;
0fe92f72 11711 struct frame *f = SELECTED_FRAME ();
333b20bb
GM		 11712 Lisp_Object file = Qnil;
11713 Widget dialog, text, list, help;
11714 Arg al[10];
11715 int ac = 0;
11716 extern XtAppContext Xt_app_con;
333b20bb 11717 XmString dir_xmstring, pattern_xmstring;
65b21658 11718 int count = SPECPDL_INDEX ();
333b20bb
GM		 11719 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
11720
11721 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
b7826503
PJ		 11722 CHECK_STRING (prompt);
11723 CHECK_STRING (dir);
333b20bb
GM		 11724
11725 /* Prevent redisplay. */
11726 specbind (Qinhibit_redisplay, Qt);
11727
11728 BLOCK_INPUT;
11729
11730 /* Create the dialog with PROMPT as title, using DIR as initial
11731 directory and using "*" as pattern. */
11732 dir = Fexpand_file_name (dir, Qnil);
d5db4077 11733 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
333b20bb 11734 pattern_xmstring = XmStringCreateLocalized ("*");
488dd4c4 11735
d5db4077 11736 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
333b20bb
GM		 11737 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
11738 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
11739 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
11740 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
11741 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
11742 "fsb", al, ac);
11743 XmStringFree (dir_xmstring);
11744 XmStringFree (pattern_xmstring);
11745
11746 /* Add callbacks for OK and Cancel. */
11747 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
11748 (XtPointer) &result);
11749 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
11750 (XtPointer) &result);
a779d213
GM		 11751 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
11752 (XtPointer) &result);
333b20bb
GM		 11753
11754 /* Disable the help button since we can't display help. */
11755 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
11756 XtSetSensitive (help, False);
11757
488dd4c4 11758 /* Mark OK button as default. */
333b20bb
GM		 11759 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
11760 XmNshowAsDefault, True, NULL);
11761
11762 /* If MUSTMATCH is non-nil, disable the file entry field of the
11763 dialog, so that the user must select a file from the files list
11764 box. We can't remove it because we wouldn't have a way to get at
11765 the result file name, then. */
11766 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
11767 if (!NILP (mustmatch))
11768 {
11769 Widget label;
11770 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
11771 XtSetSensitive (text, False);
11772 XtSetSensitive (label, False);
11773 }
11774
11775 /* Manage the dialog, so that list boxes get filled. */
11776 XtManageChild (dialog);
11777
11778 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11779 must include the path for this to work. */
11780 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
11781 if (STRINGP (default_filename))
11782 {
11783 XmString default_xmstring;
11784 int item_pos;
11785
11786 default_xmstring
d5db4077 11787 = XmStringCreateLocalized (SDATA (default_filename));
333b20bb
GM		 11788
11789 if (!XmListItemExists (list, default_xmstring))
11790 {
11791 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11792 XmListAddItem (list, default_xmstring, 0);
11793 item_pos = 0;
11794 }
11795 else
11796 item_pos = XmListItemPos (list, default_xmstring);
11797 XmStringFree (default_xmstring);
11798
11799 /* Select the item and scroll it into view. */
11800 XmListSelectPos (list, item_pos, True);
11801 XmListSetPos (list, item_pos);
11802 }
11803
bf338245 11804 /* Process events until the user presses Cancel or OK. */
03100098 11805 result = 0;
a779d213 11806 while (result == 0)
563b384d 11807 {
bf338245
JD		 11808 XEvent event;
11809 XtAppNextEvent (Xt_app_con, &event);
1fcfb866 11810 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
563b384d 11811 }
03100098 11812
333b20bb
GM		 11813 /* Get the result. */
11814 if (result == XmCR_OK)
11815 {
11816 XmString text;
11817 String data;
488dd4c4 11818
d1670063 11819 XtVaGetValues (dialog, XmNtextString, &text, NULL);
333b20bb
GM		 11820 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
11821 XmStringFree (text);
11822 file = build_string (data);
11823 XtFree (data);
11824 }
11825 else
11826 file = Qnil;
11827
11828 /* Clean up. */
11829 XtUnmanageChild (dialog);
11830 XtDestroyWidget (dialog);
11831 UNBLOCK_INPUT;
11832 UNGCPRO;
11833
11834 /* Make "Cancel" equivalent to C-g. */
11835 if (NILP (file))
11836 Fsignal (Qquit, Qnil);
488dd4c4 11837
333b20bb
GM		 11838 return unbind_to (count, file);
11839}
11840
11841#endif /* USE_MOTIF */
11842
488dd4c4
JD		 11843#ifdef USE_GTK
11844
11845DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
11846 "Read file name, prompting with PROMPT in directory DIR.\n\
11847Use a file selection dialog.\n\
11848Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11849specified. Don't let the user enter a file name in the file\n\
11850selection dialog's entry field, if MUSTMATCH is non-nil.")
11851 (prompt, dir, default_filename, mustmatch)
11852 Lisp_Object prompt, dir, default_filename, mustmatch;
11853{
11854 FRAME_PTR f = SELECTED_FRAME ();
11855 char *fn;
11856 Lisp_Object file = Qnil;
11857 int count = specpdl_ptr - specpdl;
11858 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
11859 char *cdef_file;
11860 char *cprompt;
11861
11862 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
11863 CHECK_STRING (prompt);
11864 CHECK_STRING (dir);
11865
11866 /* Prevent redisplay. */
11867 specbind (Qinhibit_redisplay, Qt);
11868
11869 BLOCK_INPUT;
11870
11871 if (STRINGP (default_filename))
11872 cdef_file = SDATA (default_filename);
11873 else
11874 cdef_file = SDATA (dir);
11875
11876 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
11877
11878 if (fn)
11879 {
11880 file = build_string (fn);
11881 xfree (fn);
11882 }
11883
11884 UNBLOCK_INPUT;
11885 UNGCPRO;
11886
11887 /* Make "Cancel" equivalent to C-g. */
11888 if (NILP (file))
11889 Fsignal (Qquit, Qnil);
11890
11891 return unbind_to (count, file);
11892}
11893
11894#endif /* USE_GTK */
333b20bb
GM		 11895
11896\f
82bab41c
GM		 11897/***********************************************************************
11898 Keyboard
11899 ***********************************************************************/
11900
11901#ifdef HAVE_XKBGETKEYBOARD
11902#include <X11/XKBlib.h>
11903#include <X11/keysym.h>
11904#endif
11905
11906DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
11907 Sx_backspace_delete_keys_p, 0, 1, 0,
7ee72033 11908 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
c061c855
GM		 11909FRAME nil means use the selected frame.
11910Value is t if we know that both keys are present, and are mapped to the
7ee72033
MB		 11911usual X keysyms. */)
11912 (frame)
82bab41c
GM		 11913 Lisp_Object frame;
11914{
11915#ifdef HAVE_XKBGETKEYBOARD
11916 XkbDescPtr kb;
11917 struct frame *f = check_x_frame (frame);
11918 Display *dpy = FRAME_X_DISPLAY (f);
11919 Lisp_Object have_keys;
46f6a258 11920 int major, minor, op, event, error;
82bab41c
GM		 11921
11922 BLOCK_INPUT;
46f6a258
GM		 11923
11924 /* Check library version in case we're dynamically linked. */
11925 major = XkbMajorVersion;
11926 minor = XkbMinorVersion;
11927 if (!XkbLibraryVersion (&major, &minor))
c1efd260
GM		 11928 {
11929 UNBLOCK_INPUT;
11930 return Qnil;
11931 }
46f6a258
GM		 11932
11933 /* Check that the server supports XKB. */
11934 major = XkbMajorVersion;
11935 minor = XkbMinorVersion;
11936 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
c1efd260
GM		 11937 {
11938 UNBLOCK_INPUT;
11939 return Qnil;
11940 }
488dd4c4 11941
46f6a258 11942 have_keys = Qnil;
c1efd260 11943 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
82bab41c
GM		 11944 if (kb)
11945 {
11946 int delete_keycode = 0, backspace_keycode = 0, i;
c1efd260
GM		 11947
11948 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
82bab41c 11949 {
c1efd260
GM		 11950 for (i = kb->min_key_code;
11951 (i < kb->max_key_code
11952 && (delete_keycode == 0 || backspace_keycode == 0));
11953 ++i)
11954 {
d63931a2
GM		 11955 /* The XKB symbolic key names can be seen most easily in
11956 the PS file generated by `xkbprint -label name
11957 $DISPLAY'. */
c1efd260
GM		 11958 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
11959 delete_keycode = i;
11960 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
11961 backspace_keycode = i;
11962 }
11963
11964 XkbFreeNames (kb, 0, True);
82bab41c
GM		 11965 }
11966
c1efd260 11967 XkbFreeClientMap (kb, 0, True);
488dd4c4 11968
82bab41c
GM		 11969 if (delete_keycode
11970 && backspace_keycode
11971 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
11972 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
11973 have_keys = Qt;
11974 }
11975 UNBLOCK_INPUT;
11976 return have_keys;
11977#else /* not HAVE_XKBGETKEYBOARD */
11978 return Qnil;
11979#endif /* not HAVE_XKBGETKEYBOARD */
11980}
11981
11982
11983\f
333b20bb
GM		 11984/***********************************************************************
11985 Initialization
11986 ***********************************************************************/
11987
11988void
11989syms_of_xfns ()
11990{
11991 /* This is zero if not using X windows. */
11992 x_in_use = 0;
11993
11994 /* The section below is built by the lisp expression at the top of the file,
11995 just above where these variables are declared. */
11996 /*&&& init symbols here &&&*/
11997 Qauto_raise = intern ("auto-raise");
11998 staticpro (&Qauto_raise);
11999 Qauto_lower = intern ("auto-lower");
12000 staticpro (&Qauto_lower);
f9942c9e
JB		 12001 Qborder_color = intern ("border-color");
12002 staticpro (&Qborder_color);
12003 Qborder_width = intern ("border-width");
12004 staticpro (&Qborder_width);
12005 Qcursor_color = intern ("cursor-color");
12006 staticpro (&Qcursor_color);
dbc4e1c1
JB		 12007 Qcursor_type = intern ("cursor-type");
12008 staticpro (&Qcursor_type);
f9942c9e
JB		 12009 Qgeometry = intern ("geometry");
12010 staticpro (&Qgeometry);
f9942c9e
JB		 12011 Qicon_left = intern ("icon-left");
12012 staticpro (&Qicon_left);
12013 Qicon_top = intern ("icon-top");
12014 staticpro (&Qicon_top);
12015 Qicon_type = intern ("icon-type");
12016 staticpro (&Qicon_type);
80534dd6
KH		 12017 Qicon_name = intern ("icon-name");
12018 staticpro (&Qicon_name);
f9942c9e
JB		 12019 Qinternal_border_width = intern ("internal-border-width");
12020 staticpro (&Qinternal_border_width);
12021 Qleft = intern ("left");
12022 staticpro (&Qleft);
1ab3d87e
RS		 12023 Qright = intern ("right");
12024 staticpro (&Qright);
f9942c9e
JB		 12025 Qmouse_color = intern ("mouse-color");
12026 staticpro (&Qmouse_color);
baaed68e
JB		 12027 Qnone = intern ("none");
12028 staticpro (&Qnone);
f9942c9e
JB		 12029 Qparent_id = intern ("parent-id");
12030 staticpro (&Qparent_id);
4701395c
KH		 12031 Qscroll_bar_width = intern ("scroll-bar-width");
12032 staticpro (&Qscroll_bar_width);
8af1d7ca
JB		 12033 Qsuppress_icon = intern ("suppress-icon");
12034 staticpro (&Qsuppress_icon);
01f1ba30 12035 Qundefined_color = intern ("undefined-color");
f9942c9e 12036 staticpro (&Qundefined_color);
a3c87d4e
JB		 12037 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
12038 staticpro (&Qvertical_scroll_bars);
49795535
JB		 12039 Qvisibility = intern ("visibility");
12040 staticpro (&Qvisibility);
f9942c9e
JB		 12041 Qwindow_id = intern ("window-id");
12042 staticpro (&Qwindow_id);
2cbebefb
RS		 12043 Qouter_window_id = intern ("outer-window-id");
12044 staticpro (&Qouter_window_id);
f9942c9e
JB		 12045 Qx_frame_parameter = intern ("x-frame-parameter");
12046 staticpro (&Qx_frame_parameter);
9ef48a9d
RS		 12047 Qx_resource_name = intern ("x-resource-name");
12048 staticpro (&Qx_resource_name);
4fe1de12
RS		 12049 Quser_position = intern ("user-position");
12050 staticpro (&Quser_position);
12051 Quser_size = intern ("user-size");
12052 staticpro (&Quser_size);
333b20bb
GM		 12053 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
12054 staticpro (&Qscroll_bar_foreground);
12055 Qscroll_bar_background = intern ("scroll-bar-background");
12056 staticpro (&Qscroll_bar_background);
d62c8769
GM		 12057 Qscreen_gamma = intern ("screen-gamma");
12058 staticpro (&Qscreen_gamma);
563b67aa
GM		 12059 Qline_spacing = intern ("line-spacing");
12060 staticpro (&Qline_spacing);
7c7ff7f5
GM		 12061 Qcenter = intern ("center");
12062 staticpro (&Qcenter);
96db09e4
KH		 12063 Qcompound_text = intern ("compound-text");
12064 staticpro (&Qcompound_text);
ae782866
GM		 12065 Qcancel_timer = intern ("cancel-timer");
12066 staticpro (&Qcancel_timer);
ea0a1f53
GM		 12067 Qwait_for_wm = intern ("wait-for-wm");
12068 staticpro (&Qwait_for_wm);
49d41073
EZ		 12069 Qfullscreen = intern ("fullscreen");
12070 staticpro (&Qfullscreen);
12071 Qfullwidth = intern ("fullwidth");
12072 staticpro (&Qfullwidth);
12073 Qfullheight = intern ("fullheight");
12074 staticpro (&Qfullheight);
12075 Qfullboth = intern ("fullboth");
12076 staticpro (&Qfullboth);
f9942c9e
JB		 12077 /* This is the end of symbol initialization. */
12078
58cad5ed
KH		 12079 /* Text property `display' should be nonsticky by default. */
12080 Vtext_property_default_nonsticky
12081 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
12082
12083
333b20bb
GM		 12084 Qlaplace = intern ("laplace");
12085 staticpro (&Qlaplace);
4a8e312c
GM		 12086 Qemboss = intern ("emboss");
12087 staticpro (&Qemboss);
12088 Qedge_detection = intern ("edge-detection");
12089 staticpro (&Qedge_detection);
12090 Qheuristic = intern ("heuristic");
12091 staticpro (&Qheuristic);
12092 QCmatrix = intern (":matrix");
12093 staticpro (&QCmatrix);
12094 QCcolor_adjustment = intern (":color-adjustment");
12095 staticpro (&QCcolor_adjustment);
12096 QCmask = intern (":mask");
12097 staticpro (&QCmask);
488dd4c4 12098
a367641f
RS		 12099 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
12100 staticpro (&Qface_set_after_frame_default);
12101
01f1ba30
JB		 12102 Fput (Qundefined_color, Qerror_conditions,
12103 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
12104 Fput (Qundefined_color, Qerror_message,
12105 build_string ("Undefined color"));
12106
f9942c9e
JB		 12107 init_x_parm_symbols ();
12108
7ee72033
MB		 12109 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
12110 doc: /* Non-nil means always draw a cross over disabled images.
c061c855
GM		 12111Disabled images are those having an `:conversion disabled' property.
12112A cross is always drawn on black & white displays. */);
14819cb3
GM		 12113 cross_disabled_images = 0;
12114
7ee72033 12115 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
c5903437 12116 doc: /* List of directories to search for window system bitmap files. */);
e241c09b 12117 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
f1c7b5a6 12118
7ee72033
MB		 12119 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
12120 doc: /* The shape of the pointer when over text.
c061c855
GM		 12121Changing the value does not affect existing frames
12122unless you set the mouse color. */);
01f1ba30
JB		 12123 Vx_pointer_shape = Qnil;
12124
7ee72033
MB		 12125 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
12126 doc: /* The name Emacs uses to look up X resources.
c061c855
GM		 12127`x-get-resource' uses this as the first component of the instance name
12128when requesting resource values.
12129Emacs initially sets `x-resource-name' to the name under which Emacs
12130was invoked, or to the value specified with the `-name' or `-rn'
12131switches, if present.
12132
12133It may be useful to bind this variable locally around a call
12134to `x-get-resource'. See also the variable `x-resource-class'. */);
d387c960 12135 Vx_resource_name = Qnil;
ac63d3d6 12136
7ee72033
MB		 12137 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
12138 doc: /* The class Emacs uses to look up X resources.
c061c855
GM		 12139`x-get-resource' uses this as the first component of the instance class
12140when requesting resource values.
12141
12142Emacs initially sets `x-resource-class' to "Emacs".
12143
12144Setting this variable permanently is not a reasonable thing to do,
12145but binding this variable locally around a call to `x-get-resource'
12146is a reasonable practice. See also the variable `x-resource-name'. */);
498e9ac3
RS		 12147 Vx_resource_class = build_string (EMACS_CLASS);
12148
ca0ecbf5 12149#if 0 /* This doesn't really do anything. */
7ee72033
MB		 12150 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
12151 doc: /* The shape of the pointer when not over text.
c061c855
GM		 12152This variable takes effect when you create a new frame
12153or when you set the mouse color. */);
af01ef26 12154#endif
01f1ba30
JB		 12155 Vx_nontext_pointer_shape = Qnil;
12156
7ee72033
MB		 12157 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
12158 doc: /* The shape of the pointer when Emacs is busy.
c061c855
GM		 12159This variable takes effect when you create a new frame
12160or when you set the mouse color. */);
0af913d7 12161 Vx_hourglass_pointer_shape = Qnil;
333b20bb 12162
7ee72033
MB		 12163 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
12164 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 12165 display_hourglass_p = 1;
488dd4c4 12166
7ee72033
MB		 12167 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
12168 doc: /* *Seconds to wait before displaying an hourglass pointer.
c061c855 12169Value must be an integer or float. */);
0af913d7 12170 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
4ae9a85e 12171
ca0ecbf5 12172#if 0 /* This doesn't really do anything. */
7ee72033
MB		 12173 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
12174 doc: /* The shape of the pointer when over the mode line.
c061c855
GM		 12175This variable takes effect when you create a new frame
12176or when you set the mouse color. */);
af01ef26 12177#endif
01f1ba30
JB		 12178 Vx_mode_pointer_shape = Qnil;
12179
d3b06468 12180 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7ee72033
MB		 12181 &Vx_sensitive_text_pointer_shape,
12182 doc: /* The shape of the pointer when over mouse-sensitive text.
c061c855
GM		 12183This variable takes effect when you create a new frame
12184or when you set the mouse color. */);
ca0ecbf5 12185 Vx_sensitive_text_pointer_shape = Qnil;
95f80c78 12186
8fb4ec9c 12187 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7ee72033
MB		 12188 &Vx_window_horizontal_drag_shape,
12189 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
c061c855
GM		 12190This variable takes effect when you create a new frame
12191or when you set the mouse color. */);
8fb4ec9c
GM		 12192 Vx_window_horizontal_drag_shape = Qnil;
12193
7ee72033
MB		 12194 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
12195 doc: /* A string indicating the foreground color of the cursor box. */);
01f1ba30
JB		 12196 Vx_cursor_fore_pixel = Qnil;
12197
7ee72033
MB		 12198 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
12199 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
c061c855 12200Text larger than this is clipped. */);
d63931a2 12201 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
488dd4c4 12202
7ee72033
MB		 12203 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
12204 doc: /* Non-nil if no X window manager is in use.
c061c855
GM		 12205Emacs doesn't try to figure this out; this is always nil
12206unless you set it to something else. */);
2d38195d
RS		 12207 /* We don't have any way to find this out, so set it to nil
12208 and maybe the user would like to set it to t. */
12209 Vx_no_window_manager = Qnil;
1d3dac41 12210
942ea06d 12211 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7ee72033
MB		 12212 &Vx_pixel_size_width_font_regexp,
12213 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
c061c855
GM		 12214
12215Since Emacs gets width of a font matching with this regexp from
12216PIXEL_SIZE field of the name, font finding mechanism gets faster for
12217such a font. This is especially effective for such large fonts as
12218Chinese, Japanese, and Korean. */);
942ea06d
KH		 12219 Vx_pixel_size_width_font_regexp = Qnil;
12220
7ee72033
MB		 12221 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
12222 doc: /* Time after which cached images are removed from the cache.
c061c855
GM		 12223When an image has not been displayed this many seconds, remove it
12224from the image cache. Value must be an integer or nil with nil
12225meaning don't clear the cache. */);
fcf431dc 12226 Vimage_cache_eviction_delay = make_number (30 * 60);
333b20bb 12227
1d3dac41 12228#ifdef USE_X_TOOLKIT
6f3f6a8d 12229 Fprovide (intern ("x-toolkit"), Qnil);
5b827abb 12230#ifdef USE_MOTIF
6f3f6a8d 12231 Fprovide (intern ("motif"), Qnil);
fc2cdd9a 12232
7ee72033
MB		 12233 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
12234 doc: /* Version info for LessTif/Motif. */);
fc2cdd9a
GM		 12235 Vmotif_version_string = build_string (XmVERSION_STRING);
12236#endif /* USE_MOTIF */
12237#endif /* USE_X_TOOLKIT */
01f1ba30 12238
01f1ba30 12239 defsubr (&Sx_get_resource);
333b20bb
GM		 12240
12241 /* X window properties. */
12242 defsubr (&Sx_change_window_property);
12243 defsubr (&Sx_delete_window_property);
12244 defsubr (&Sx_window_property);
12245
2d764c78 12246 defsubr (&Sxw_display_color_p);
d0c9d219 12247 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 12248 defsubr (&Sxw_color_defined_p);
12249 defsubr (&Sxw_color_values);
9d317b2c 12250 defsubr (&Sx_server_max_request_size);
41beb8fc
RS		 12251 defsubr (&Sx_server_vendor);
12252 defsubr (&Sx_server_version);
12253 defsubr (&Sx_display_pixel_width);
12254 defsubr (&Sx_display_pixel_height);
12255 defsubr (&Sx_display_mm_width);
12256 defsubr (&Sx_display_mm_height);
12257 defsubr (&Sx_display_screens);
12258 defsubr (&Sx_display_planes);
12259 defsubr (&Sx_display_color_cells);
12260 defsubr (&Sx_display_visual_class);
12261 defsubr (&Sx_display_backing_store);
12262 defsubr (&Sx_display_save_under);
8af1d7ca 12263 defsubr (&Sx_parse_geometry);
f676886a 12264 defsubr (&Sx_create_frame);
01f1ba30 12265 defsubr (&Sx_open_connection);
08a90d6a
RS		 12266 defsubr (&Sx_close_connection);
12267 defsubr (&Sx_display_list);
01f1ba30 12268 defsubr (&Sx_synchronize);
3decc1e7 12269 defsubr (&Sx_focus_frame);
82bab41c 12270 defsubr (&Sx_backspace_delete_keys_p);
488dd4c4 12271
942ea06d
KH		 12272 /* Setting callback functions for fontset handler. */
12273 get_font_info_func = x_get_font_info;
333b20bb
GM		 12274
12275#if 0 /* This function pointer doesn't seem to be used anywhere.
12276 And the pointer assigned has the wrong type, anyway. */
942ea06d 12277 list_fonts_func = x_list_fonts;
333b20bb 12278#endif
488dd4c4 12279
942ea06d 12280 load_font_func = x_load_font;
bc1958c4 12281 find_ccl_program_func = x_find_ccl_program;
942ea06d
KH		 12282 query_font_func = x_query_font;
12283 set_frame_fontset_func = x_set_font;
12284 check_window_system_func = check_x;
333b20bb
GM		 12285
12286 /* Images. */
12287 Qxbm = intern ("xbm");
12288 staticpro (&Qxbm);
d2dc8167
GM		 12289 QCconversion = intern (":conversion");
12290 staticpro (&QCconversion);
333b20bb
GM		 12291 QCheuristic_mask = intern (":heuristic-mask");
12292 staticpro (&QCheuristic_mask);
12293 QCcolor_symbols = intern (":color-symbols");
12294 staticpro (&QCcolor_symbols);
333b20bb
GM		 12295 QCascent = intern (":ascent");
12296 staticpro (&QCascent);
12297 QCmargin = intern (":margin");
12298 staticpro (&QCmargin);
12299 QCrelief = intern (":relief");
12300 staticpro (&QCrelief);
fcf431dc
GM		 12301 Qpostscript = intern ("postscript");
12302 staticpro (&Qpostscript);
333b20bb
GM		 12303 QCloader = intern (":loader");
12304 staticpro (&QCloader);
12305 QCbounding_box = intern (":bounding-box");
12306 staticpro (&QCbounding_box);
12307 QCpt_width = intern (":pt-width");
12308 staticpro (&QCpt_width);
12309 QCpt_height = intern (":pt-height");
12310 staticpro (&QCpt_height);
3ccff1e3
GM		 12311 QCindex = intern (":index");
12312 staticpro (&QCindex);
333b20bb
GM		 12313 Qpbm = intern ("pbm");
12314 staticpro (&Qpbm);
12315
12316#if HAVE_XPM
12317 Qxpm = intern ("xpm");
12318 staticpro (&Qxpm);
12319#endif
488dd4c4 12320
333b20bb
GM		 12321#if HAVE_JPEG
12322 Qjpeg = intern ("jpeg");
12323 staticpro (&Qjpeg);
488dd4c4 12324#endif
333b20bb
GM		 12325
12326#if HAVE_TIFF
12327 Qtiff = intern ("tiff");
12328 staticpro (&Qtiff);
488dd4c4 12329#endif
333b20bb
GM		 12330
12331#if HAVE_GIF
12332 Qgif = intern ("gif");
12333 staticpro (&Qgif);
12334#endif
12335
12336#if HAVE_PNG
12337 Qpng = intern ("png");
12338 staticpro (&Qpng);
12339#endif
12340
12341 defsubr (&Sclear_image_cache);
42677916 12342 defsubr (&Simage_size);
b243755a 12343 defsubr (&Simage_mask_p);
333b20bb 12344
0af913d7
GM		 12345 hourglass_atimer = NULL;
12346 hourglass_shown_p = 0;
333b20bb
GM		 12347
12348 defsubr (&Sx_show_tip);
12349 defsubr (&Sx_hide_tip);
333b20bb 12350 tip_timer = Qnil;
44b5a125
GM		 12351 staticpro (&tip_timer);
12352 tip_frame = Qnil;
12353 staticpro (&tip_frame);
333b20bb 12354
06d62053
GM		 12355 last_show_tip_args = Qnil;
12356 staticpro (&last_show_tip_args);
12357
333b20bb
GM		 12358#ifdef USE_MOTIF
12359 defsubr (&Sx_file_dialog);
12360#endif
12361}
12362
12363
12364void
12365init_xfns ()
12366{
12367 image_types = NULL;
12368 Vimage_types = Qnil;
488dd4c4 12369
333b20bb
GM		 12370 define_image_type (&xbm_type);
12371 define_image_type (&gs_type);
12372 define_image_type (&pbm_type);
488dd4c4 12373
333b20bb
GM		 12374#if HAVE_XPM
12375 define_image_type (&xpm_type);
12376#endif
488dd4c4 12377
333b20bb
GM		 12378#if HAVE_JPEG
12379 define_image_type (&jpeg_type);
12380#endif
488dd4c4 12381
333b20bb
GM		 12382#if HAVE_TIFF
12383 define_image_type (&tiff_type);
12384#endif
488dd4c4 12385
333b20bb
GM		 12386#if HAVE_GIF
12387 define_image_type (&gif_type);
12388#endif
488dd4c4 12389
333b20bb
GM		 12390#if HAVE_PNG
12391 define_image_type (&png_type);
12392#endif
01f1ba30
JB		 12393}
12394
12395#endif /* HAVE_X_WINDOWS */
Unnamed repository; edit this file 'description' to name the repository.