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