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