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