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