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