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