* xfns.c (x_create_bitmap_mask): Removed unused variable depth.
[emacs.git] / src / xfns.c
blobcecffb1c222741816a58796a7eb66d449f8b3b31
1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03
3 Free Software Foundation.
5 This file is part of GNU Emacs.
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.
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.
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. */
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <math.h>
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
31 /* This makes the fields of a Display accessible, in Xlib header files. */
33 #define XLIB_ILLEGAL_ACCESS
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"
52 #ifdef HAVE_X_WINDOWS
54 #include <ctype.h>
55 #include <sys/types.h>
56 #include <sys/stat.h>
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
68 #ifdef USE_GTK
69 #include "gtkutil.h"
70 #endif
72 #ifdef USE_X_TOOLKIT
73 #include <X11/Shell.h>
75 #ifndef USE_MOTIF
76 #include <X11/Xaw/Paned.h>
77 #include <X11/Xaw/Label.h>
78 #endif /* USE_MOTIF */
80 #ifdef USG
81 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include <X11/Xos.h>
83 #define USG
84 #else
85 #include <X11/Xos.h>
86 #endif
88 #include "widget.h"
90 #include "../lwlib/lwlib.h"
92 #ifdef USE_MOTIF
93 #include <Xm/Xm.h>
94 #include <Xm/DialogS.h>
95 #include <Xm/FileSB.h>
96 #endif
98 /* Do the EDITRES protocol if running X11R5
99 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
102 #define HACK_EDITRES
103 extern void _XEditResCheckMessages ();
104 #endif /* R5 + Athena */
106 /* Unique id counter for widgets created by the Lucid Widget Library. */
108 extern LWLIB_ID widget_id_tick;
110 #ifdef USE_LUCID
111 /* This is part of a kludge--see lwlib/xlwmenu.c. */
112 extern XFontStruct *xlwmenu_default_font;
113 #endif
115 extern void free_frame_menubar ();
116 extern double atof ();
118 #ifdef USE_MOTIF
120 /* LessTif/Motif version info. */
122 static Lisp_Object Vmotif_version_string;
124 #endif /* USE_MOTIF */
126 #endif /* USE_X_TOOLKIT */
128 #ifdef USE_GTK
130 /* GTK+ version info */
132 static Lisp_Object Vgtk_version_string;
134 #endif /* USE_GTK */
136 #ifdef HAVE_X11R4
137 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
138 #else
139 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
140 #endif
142 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
143 it, and including `bitmaps/gray' more than once is a problem when
144 config.h defines `static' as an empty replacement string. */
146 int gray_bitmap_width = gray_width;
147 int gray_bitmap_height = gray_height;
148 char *gray_bitmap_bits = gray_bits;
150 /* Non-zero means we're allowed to display an hourglass cursor. */
152 int display_hourglass_p;
154 /* The background and shape of the mouse pointer, and shape when not
155 over text or in the modeline. */
157 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
158 Lisp_Object Vx_hourglass_pointer_shape;
160 /* The shape when over mouse-sensitive text. */
162 Lisp_Object Vx_sensitive_text_pointer_shape;
164 /* If non-nil, the pointer shape to indicate that windows can be
165 dragged horizontally. */
167 Lisp_Object Vx_window_horizontal_drag_shape;
169 /* Color of chars displayed in cursor box. */
171 Lisp_Object Vx_cursor_fore_pixel;
173 /* Nonzero if using X. */
175 static int x_in_use;
177 /* Non nil if no window manager is in use. */
179 Lisp_Object Vx_no_window_manager;
181 /* Search path for bitmap files. */
183 Lisp_Object Vx_bitmap_file_path;
185 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
187 Lisp_Object Vx_pixel_size_width_font_regexp;
189 Lisp_Object Qnone;
190 Lisp_Object Qsuppress_icon;
191 Lisp_Object Qundefined_color;
192 Lisp_Object Qcenter;
193 Lisp_Object Qcompound_text, Qcancel_timer;
195 /* In dispnew.c */
197 extern Lisp_Object Vwindow_system_version;
199 /* The below are defined in frame.c. */
201 #if GLYPH_DEBUG
202 int image_cache_refcount, dpyinfo_refcount;
203 #endif
207 /* Error if we are not connected to X. */
209 void
210 check_x ()
212 if (! x_in_use)
213 error ("X windows are not in use or not initialized");
216 /* Nonzero if we can use mouse menus.
217 You should not call this unless HAVE_MENUS is defined. */
220 have_menus_p ()
222 return x_in_use;
225 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
226 and checking validity for X. */
228 FRAME_PTR
229 check_x_frame (frame)
230 Lisp_Object frame;
232 FRAME_PTR f;
234 if (NILP (frame))
235 frame = selected_frame;
236 CHECK_LIVE_FRAME (frame);
237 f = XFRAME (frame);
238 if (! FRAME_X_P (f))
239 error ("Non-X frame used");
240 return f;
243 /* Let the user specify an X display with a frame.
244 nil stands for the selected frame--or, if that is not an X frame,
245 the first X display on the list. */
247 struct x_display_info *
248 check_x_display_info (frame)
249 Lisp_Object frame;
251 struct x_display_info *dpyinfo = NULL;
253 if (NILP (frame))
255 struct frame *sf = XFRAME (selected_frame);
257 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
258 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
259 else if (x_display_list != 0)
260 dpyinfo = x_display_list;
261 else
262 error ("X windows are not in use or not initialized");
264 else if (STRINGP (frame))
265 dpyinfo = x_display_info_for_name (frame);
266 else
268 FRAME_PTR f = check_x_frame (frame);
269 dpyinfo = FRAME_X_DISPLAY_INFO (f);
272 return dpyinfo;
276 /* Return the Emacs frame-object corresponding to an X window.
277 It could be the frame's main window or an icon window. */
279 /* This function can be called during GC, so use GC_xxx type test macros. */
281 struct frame *
282 x_window_to_frame (dpyinfo, wdesc)
283 struct x_display_info *dpyinfo;
284 int wdesc;
286 Lisp_Object tail, frame;
287 struct frame *f;
289 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
291 frame = XCAR (tail);
292 if (!GC_FRAMEP (frame))
293 continue;
294 f = XFRAME (frame);
295 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
296 continue;
297 if (f->output_data.x->hourglass_window == wdesc)
298 return f;
299 #ifdef USE_X_TOOLKIT
300 if ((f->output_data.x->edit_widget
301 && XtWindow (f->output_data.x->edit_widget) == wdesc)
302 /* A tooltip frame? */
303 || (!f->output_data.x->edit_widget
304 && FRAME_X_WINDOW (f) == wdesc)
305 || f->output_data.x->icon_desc == wdesc)
306 return f;
307 #else /* not USE_X_TOOLKIT */
308 #ifdef USE_GTK
309 if (f->output_data.x->edit_widget)
311 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
312 struct x_output *x = f->output_data.x;
313 if (gwdesc != 0 && gwdesc == x->edit_widget)
314 return f;
316 #endif /* USE_GTK */
317 if (FRAME_X_WINDOW (f) == wdesc
318 || f->output_data.x->icon_desc == wdesc)
319 return f;
320 #endif /* not USE_X_TOOLKIT */
322 return 0;
325 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
326 /* Like x_window_to_frame but also compares the window with the widget's
327 windows. */
329 struct frame *
330 x_any_window_to_frame (dpyinfo, wdesc)
331 struct x_display_info *dpyinfo;
332 int wdesc;
334 Lisp_Object tail, frame;
335 struct frame *f, *found;
336 struct x_output *x;
338 found = NULL;
339 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
341 frame = XCAR (tail);
342 if (!GC_FRAMEP (frame))
343 continue;
345 f = XFRAME (frame);
346 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
348 /* This frame matches if the window is any of its widgets. */
349 x = f->output_data.x;
350 if (x->hourglass_window == wdesc)
351 found = f;
352 else if (x->widget)
354 #ifdef USE_GTK
355 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
356 if (gwdesc != 0
357 && (gwdesc == x->widget
358 || gwdesc == x->edit_widget
359 || gwdesc == x->vbox_widget
360 || gwdesc == x->menubar_widget))
361 found = f;
362 #else
363 if (wdesc == XtWindow (x->widget)
364 || wdesc == XtWindow (x->column_widget)
365 || wdesc == XtWindow (x->edit_widget))
366 found = f;
367 /* Match if the window is this frame's menubar. */
368 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
369 found = f;
370 #endif
372 else if (FRAME_X_WINDOW (f) == wdesc)
373 /* A tooltip frame. */
374 found = f;
378 return found;
381 /* Likewise, but exclude the menu bar widget. */
383 struct frame *
384 x_non_menubar_window_to_frame (dpyinfo, wdesc)
385 struct x_display_info *dpyinfo;
386 int wdesc;
388 Lisp_Object tail, frame;
389 struct frame *f;
390 struct x_output *x;
392 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
394 frame = XCAR (tail);
395 if (!GC_FRAMEP (frame))
396 continue;
397 f = XFRAME (frame);
398 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
399 continue;
400 x = f->output_data.x;
401 /* This frame matches if the window is any of its widgets. */
402 if (x->hourglass_window == wdesc)
403 return f;
404 else if (x->widget)
406 #ifdef USE_GTK
407 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
408 if (gwdesc != 0
409 && (gwdesc == x->widget
410 || gwdesc == x->edit_widget
411 || gwdesc == x->vbox_widget))
412 return f;
413 #else
414 if (wdesc == XtWindow (x->widget)
415 || wdesc == XtWindow (x->column_widget)
416 || wdesc == XtWindow (x->edit_widget))
417 return f;
418 #endif
420 else if (FRAME_X_WINDOW (f) == wdesc)
421 /* A tooltip frame. */
422 return f;
424 return 0;
427 /* Likewise, but consider only the menu bar widget. */
429 struct frame *
430 x_menubar_window_to_frame (dpyinfo, wdesc)
431 struct x_display_info *dpyinfo;
432 int wdesc;
434 Lisp_Object tail, frame;
435 struct frame *f;
436 struct x_output *x;
438 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
440 frame = XCAR (tail);
441 if (!GC_FRAMEP (frame))
442 continue;
443 f = XFRAME (frame);
444 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
445 continue;
446 x = f->output_data.x;
447 /* Match if the window is this frame's menubar. */
448 #ifdef USE_GTK
449 if (x->menubar_widget)
451 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
452 int found = 0;
454 BLOCK_INPUT;
455 if (gwdesc != 0
456 && (gwdesc == x->menubar_widget
457 || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
458 found = 1;
459 UNBLOCK_INPUT;
460 if (found) return f;
462 #else
463 if (x->menubar_widget
464 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
465 return f;
466 #endif
468 return 0;
471 /* Return the frame whose principal (outermost) window is WDESC.
472 If WDESC is some other (smaller) window, we return 0. */
474 struct frame *
475 x_top_window_to_frame (dpyinfo, wdesc)
476 struct x_display_info *dpyinfo;
477 int wdesc;
479 Lisp_Object tail, frame;
480 struct frame *f;
481 struct x_output *x;
483 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
485 frame = XCAR (tail);
486 if (!GC_FRAMEP (frame))
487 continue;
488 f = XFRAME (frame);
489 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
490 continue;
491 x = f->output_data.x;
493 if (x->widget)
495 /* This frame matches if the window is its topmost widget. */
496 #ifdef USE_GTK
497 GtkWidget *gwdesc = xg_win_to_widget (dpyinfo->display, wdesc);
498 if (gwdesc == x->widget)
499 return f;
500 #else
501 if (wdesc == XtWindow (x->widget))
502 return f;
503 #if 0 /* I don't know why it did this,
504 but it seems logically wrong,
505 and it causes trouble for MapNotify events. */
506 /* Match if the window is this frame's menubar. */
507 if (x->menubar_widget
508 && wdesc == XtWindow (x->menubar_widget))
509 return f;
510 #endif
511 #endif
513 else if (FRAME_X_WINDOW (f) == wdesc)
514 /* Tooltip frame. */
515 return f;
517 return 0;
519 #endif /* USE_X_TOOLKIT || USE_GTK */
523 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
524 id, which is just an int that this section returns. Bitmaps are
525 reference counted so they can be shared among frames.
527 Bitmap indices are guaranteed to be > 0, so a negative number can
528 be used to indicate no bitmap.
530 If you use x_create_bitmap_from_data, then you must keep track of
531 the bitmaps yourself. That is, creating a bitmap from the same
532 data more than once will not be caught. */
535 /* Functions to access the contents of a bitmap, given an id. */
538 x_bitmap_height (f, id)
539 FRAME_PTR f;
540 int id;
542 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
546 x_bitmap_width (f, id)
547 FRAME_PTR f;
548 int id;
550 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
554 x_bitmap_pixmap (f, id)
555 FRAME_PTR f;
556 int id;
558 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
562 x_bitmap_mask (f, id)
563 FRAME_PTR f;
564 int id;
566 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
570 /* Allocate a new bitmap record. Returns index of new record. */
572 static int
573 x_allocate_bitmap_record (f)
574 FRAME_PTR f;
576 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
577 int i;
579 if (dpyinfo->bitmaps == NULL)
581 dpyinfo->bitmaps_size = 10;
582 dpyinfo->bitmaps
583 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
584 dpyinfo->bitmaps_last = 1;
585 return 1;
588 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
589 return ++dpyinfo->bitmaps_last;
591 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
592 if (dpyinfo->bitmaps[i].refcount == 0)
593 return i + 1;
595 dpyinfo->bitmaps_size *= 2;
596 dpyinfo->bitmaps
597 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
598 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
599 return ++dpyinfo->bitmaps_last;
602 /* Add one reference to the reference count of the bitmap with id ID. */
604 void
605 x_reference_bitmap (f, id)
606 FRAME_PTR f;
607 int id;
609 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
612 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
615 x_create_bitmap_from_data (f, bits, width, height)
616 struct frame *f;
617 char *bits;
618 unsigned int width, height;
620 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
621 Pixmap bitmap;
622 int id;
624 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
625 bits, width, height);
629 if (! bitmap)
630 return -1;
632 id = x_allocate_bitmap_record (f);
633 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
634 dpyinfo->bitmaps[id - 1].have_mask = 0;
635 dpyinfo->bitmaps[id - 1].file = NULL;
636 dpyinfo->bitmaps[id - 1].refcount = 1;
637 dpyinfo->bitmaps[id - 1].depth = 1;
638 dpyinfo->bitmaps[id - 1].height = height;
639 dpyinfo->bitmaps[id - 1].width = width;
641 return id;
644 /* Create bitmap from file FILE for frame F. */
647 x_create_bitmap_from_file (f, file)
648 struct frame *f;
649 Lisp_Object file;
651 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
652 unsigned int width, height;
653 Pixmap bitmap;
654 int xhot, yhot, result, id;
655 Lisp_Object found;
656 int fd;
657 char *filename;
659 /* Look for an existing bitmap with the same name. */
660 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
662 if (dpyinfo->bitmaps[id].refcount
663 && dpyinfo->bitmaps[id].file
664 && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
666 ++dpyinfo->bitmaps[id].refcount;
667 return id + 1;
671 /* Search bitmap-file-path for the file, if appropriate. */
672 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
673 if (fd < 0)
674 return -1;
675 emacs_close (fd);
677 filename = (char *) SDATA (found);
679 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
680 filename, &width, &height, &bitmap, &xhot, &yhot);
681 if (result != BitmapSuccess)
682 return -1;
684 id = x_allocate_bitmap_record (f);
685 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
686 dpyinfo->bitmaps[id - 1].have_mask = 0;
687 dpyinfo->bitmaps[id - 1].refcount = 1;
688 dpyinfo->bitmaps[id - 1].file
689 = (char *) xmalloc (SBYTES (file) + 1);
690 dpyinfo->bitmaps[id - 1].depth = 1;
691 dpyinfo->bitmaps[id - 1].height = height;
692 dpyinfo->bitmaps[id - 1].width = width;
693 strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
695 return id;
698 /* Remove reference to bitmap with id number ID. */
700 void
701 x_destroy_bitmap (f, id)
702 FRAME_PTR f;
703 int id;
705 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
707 if (id > 0)
709 --dpyinfo->bitmaps[id - 1].refcount;
710 if (dpyinfo->bitmaps[id - 1].refcount == 0)
712 BLOCK_INPUT;
713 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
714 if (dpyinfo->bitmaps[id - 1].have_mask)
715 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].mask);
716 if (dpyinfo->bitmaps[id - 1].file)
718 xfree (dpyinfo->bitmaps[id - 1].file);
719 dpyinfo->bitmaps[id - 1].file = NULL;
721 UNBLOCK_INPUT;
726 /* Free all the bitmaps for the display specified by DPYINFO. */
728 static void
729 x_destroy_all_bitmaps (dpyinfo)
730 struct x_display_info *dpyinfo;
732 int i;
733 for (i = 0; i < dpyinfo->bitmaps_last; i++)
734 if (dpyinfo->bitmaps[i].refcount > 0)
736 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
737 if (dpyinfo->bitmaps[i].have_mask)
738 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].mask);
739 if (dpyinfo->bitmaps[i].file)
740 xfree (dpyinfo->bitmaps[i].file);
742 dpyinfo->bitmaps_last = 0;
748 /* Useful functions defined in the section
749 `Image type independent image structures' below. */
751 static unsigned long four_corners_best P_ ((XImage *ximg, unsigned long width,
752 unsigned long height));
754 static int x_create_x_image_and_pixmap P_ ((struct frame *f, int width, int height,
755 int depth, XImage **ximg,
756 Pixmap *pixmap));
758 static void x_destroy_x_image P_ ((XImage *ximg));
761 /* Create a mask of a bitmap. Note is this not a perfect mask.
762 It's nicer with some borders in this context */
765 x_create_bitmap_mask (f, id)
766 struct frame *f;
767 int id;
769 Pixmap pixmap, mask;
770 XImage *ximg, *mask_img;
771 unsigned long width, height;
772 int result;
773 unsigned long bg;
774 unsigned long x, y, xp, xm, yp, ym;
775 GC gc;
777 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
779 if (!(id > 0))
780 return -1;
782 pixmap = x_bitmap_pixmap (f, id);
783 width = x_bitmap_width (f, id);
784 height = x_bitmap_height (f, id);
786 BLOCK_INPUT;
787 ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
788 ~0, ZPixmap);
790 if (!ximg)
792 UNBLOCK_INPUT;
793 return -1;
796 result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
798 UNBLOCK_INPUT;
799 if (!result)
801 XDestroyImage (ximg);
802 return -1;
805 bg = four_corners_best (ximg, width, height);
807 for (y = 0; y < ximg->height; ++y)
809 for (x = 0; x < ximg->width; ++x)
811 xp = x != ximg->width - 1 ? x + 1 : 0;
812 xm = x != 0 ? x - 1 : ximg->width - 1;
813 yp = y != ximg->height - 1 ? y + 1 : 0;
814 ym = y != 0 ? y - 1 : ximg->height - 1;
815 if (XGetPixel (ximg, x, y) == bg
816 && XGetPixel (ximg, x, yp) == bg
817 && XGetPixel (ximg, x, ym) == bg
818 && XGetPixel (ximg, xp, y) == bg
819 && XGetPixel (ximg, xp, yp) == bg
820 && XGetPixel (ximg, xp, ym) == bg
821 && XGetPixel (ximg, xm, y) == bg
822 && XGetPixel (ximg, xm, yp) == bg
823 && XGetPixel (ximg, xm, ym) == bg)
824 XPutPixel (mask_img, x, y, 0);
825 else
826 XPutPixel (mask_img, x, y, 1);
830 xassert (interrupt_input_blocked);
831 gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
832 XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
833 width, height);
834 XFreeGC (FRAME_X_DISPLAY (f), gc);
836 dpyinfo->bitmaps[id - 1].have_mask = 1;
837 dpyinfo->bitmaps[id - 1].mask = mask;
839 XDestroyImage (ximg);
840 x_destroy_x_image (mask_img);
842 return 0;
845 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
846 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
847 static void x_disable_image P_ ((struct frame *, struct image *));
849 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
850 static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
851 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
852 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
853 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
854 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
855 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
856 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
857 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
858 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
859 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
860 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
861 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
862 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
863 Lisp_Object));
864 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
865 Lisp_Object));
866 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
867 Lisp_Object,
868 Lisp_Object,
869 char *, char *,
870 int));
871 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
872 Lisp_Object));
873 static void init_color_table P_ ((void));
874 static void free_color_table P_ ((void));
875 static unsigned long *colors_in_color_table P_ ((int *n));
876 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
877 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
883 /* Store the screen positions of frame F into XPTR and YPTR.
884 These are the positions of the containing window manager window,
885 not Emacs's own window. */
887 void
888 x_real_positions (f, xptr, yptr)
889 FRAME_PTR f;
890 int *xptr, *yptr;
892 int win_x, win_y, outer_x, outer_y;
893 int real_x = 0, real_y = 0;
894 int had_errors = 0;
895 Window win = f->output_data.x->parent_desc;
897 int count;
899 BLOCK_INPUT;
901 count = x_catch_errors (FRAME_X_DISPLAY (f));
903 if (win == FRAME_X_DISPLAY_INFO (f)->root_window)
904 win = FRAME_OUTER_WINDOW (f);
906 /* This loop traverses up the containment tree until we hit the root
907 window. Window managers may intersect many windows between our window
908 and the root window. The window we find just before the root window
909 should be the outer WM window. */
910 for (;;)
912 Window wm_window, rootw;
913 Window *tmp_children;
914 unsigned int tmp_nchildren;
915 int success;
917 success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
918 &wm_window, &tmp_children, &tmp_nchildren);
920 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
922 /* Don't free tmp_children if XQueryTree failed. */
923 if (! success)
924 break;
926 XFree ((char *) tmp_children);
928 if (wm_window == rootw || had_errors)
929 break;
931 win = wm_window;
934 if (! had_errors)
936 int ign;
937 Window child, rootw;
939 /* Get the real coordinates for the WM window upper left corner */
940 XGetGeometry (FRAME_X_DISPLAY (f), win,
941 &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
943 /* Translate real coordinates to coordinates relative to our
944 window. For our window, the upper left corner is 0, 0.
945 Since the upper left corner of the WM window is outside
946 our window, win_x and win_y will be negative:
948 ------------------ ---> x
949 | title |
950 | ----------------- v y
951 | | our window
953 XTranslateCoordinates (FRAME_X_DISPLAY (f),
955 /* From-window, to-window. */
956 FRAME_X_DISPLAY_INFO (f)->root_window,
957 FRAME_X_WINDOW (f),
959 /* From-position, to-position. */
960 real_x, real_y, &win_x, &win_y,
962 /* Child of win. */
963 &child);
965 if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f))
967 outer_x = win_x;
968 outer_y = win_y;
970 else
972 XTranslateCoordinates (FRAME_X_DISPLAY (f),
974 /* From-window, to-window. */
975 FRAME_X_DISPLAY_INFO (f)->root_window,
976 FRAME_OUTER_WINDOW (f),
978 /* From-position, to-position. */
979 real_x, real_y, &outer_x, &outer_y,
981 /* Child of win. */
982 &child);
985 had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
988 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
990 UNBLOCK_INPUT;
992 if (had_errors) return;
994 f->x_pixels_diff = -win_x;
995 f->y_pixels_diff = -win_y;
997 FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
998 FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
1000 *xptr = real_x;
1001 *yptr = real_y;
1007 /* Gamma-correct COLOR on frame F. */
1009 void
1010 gamma_correct (f, color)
1011 struct frame *f;
1012 XColor *color;
1014 if (f->gamma)
1016 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1017 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1018 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1023 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1024 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1025 allocate the color. Value is zero if COLOR_NAME is invalid, or
1026 no color could be allocated. */
1029 x_defined_color (f, color_name, color, alloc_p)
1030 struct frame *f;
1031 char *color_name;
1032 XColor *color;
1033 int alloc_p;
1035 int success_p;
1036 Display *dpy = FRAME_X_DISPLAY (f);
1037 Colormap cmap = FRAME_X_COLORMAP (f);
1039 BLOCK_INPUT;
1040 success_p = XParseColor (dpy, cmap, color_name, color);
1041 if (success_p && alloc_p)
1042 success_p = x_alloc_nearest_color (f, cmap, color);
1043 UNBLOCK_INPUT;
1045 return success_p;
1049 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1050 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1051 Signal an error if color can't be allocated. */
1054 x_decode_color (f, color_name, mono_color)
1055 FRAME_PTR f;
1056 Lisp_Object color_name;
1057 int mono_color;
1059 XColor cdef;
1061 CHECK_STRING (color_name);
1063 #if 0 /* Don't do this. It's wrong when we're not using the default
1064 colormap, it makes freeing difficult, and it's probably not
1065 an important optimization. */
1066 if (strcmp (SDATA (color_name), "black") == 0)
1067 return BLACK_PIX_DEFAULT (f);
1068 else if (strcmp (SDATA (color_name), "white") == 0)
1069 return WHITE_PIX_DEFAULT (f);
1070 #endif
1072 /* Return MONO_COLOR for monochrome frames. */
1073 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1074 return mono_color;
1076 /* x_defined_color is responsible for coping with failures
1077 by looking for a near-miss. */
1078 if (x_defined_color (f, SDATA (color_name), &cdef, 1))
1079 return cdef.pixel;
1081 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1082 Fcons (color_name, Qnil)));
1083 return 0;
1088 /* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1089 the previous value of that parameter, NEW_VALUE is the new value.
1090 See also the comment of wait_for_wm in struct x_output. */
1092 static void
1093 x_set_wait_for_wm (f, new_value, old_value)
1094 struct frame *f;
1095 Lisp_Object new_value, old_value;
1097 f->output_data.x->wait_for_wm = !NILP (new_value);
1100 #ifdef USE_GTK
1102 static Lisp_Object x_find_image_file P_ ((Lisp_Object file));
1104 /* Set icon from FILE for frame F. By using GTK functions the icon
1105 may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
1108 xg_set_icon (f, file)
1109 FRAME_PTR f;
1110 Lisp_Object file;
1112 struct gcpro gcpro1;
1113 int result = 0;
1114 Lisp_Object found;
1116 GCPRO1 (found);
1118 found = x_find_image_file (file);
1120 if (! NILP (found))
1122 GdkPixbuf *pixbuf;
1123 GError *err = NULL;
1124 char *filename;
1126 filename = SDATA (found);
1127 BLOCK_INPUT;
1129 pixbuf = gdk_pixbuf_new_from_file (filename, &err);
1131 if (pixbuf)
1133 gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1134 pixbuf);
1135 g_object_unref (pixbuf);
1137 result = 1;
1139 else
1140 g_error_free (err);
1142 UNBLOCK_INPUT;
1145 UNGCPRO;
1146 return result;
1148 #endif /* USE_GTK */
1151 /* Functions called only from `x_set_frame_param'
1152 to set individual parameters.
1154 If FRAME_X_WINDOW (f) is 0,
1155 the frame is being created and its X-window does not exist yet.
1156 In that case, just record the parameter's new value
1157 in the standard place; do not attempt to change the window. */
1159 void
1160 x_set_foreground_color (f, arg, oldval)
1161 struct frame *f;
1162 Lisp_Object arg, oldval;
1164 struct x_output *x = f->output_data.x;
1165 unsigned long fg, old_fg;
1167 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1168 old_fg = x->foreground_pixel;
1169 x->foreground_pixel = fg;
1171 if (FRAME_X_WINDOW (f) != 0)
1173 Display *dpy = FRAME_X_DISPLAY (f);
1175 BLOCK_INPUT;
1176 XSetForeground (dpy, x->normal_gc, fg);
1177 XSetBackground (dpy, x->reverse_gc, fg);
1179 if (x->cursor_pixel == old_fg)
1181 unload_color (f, x->cursor_pixel);
1182 x->cursor_pixel = x_copy_color (f, fg);
1183 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1186 UNBLOCK_INPUT;
1188 update_face_from_frame_parameter (f, Qforeground_color, arg);
1190 if (FRAME_VISIBLE_P (f))
1191 redraw_frame (f);
1194 unload_color (f, old_fg);
1197 void
1198 x_set_background_color (f, arg, oldval)
1199 struct frame *f;
1200 Lisp_Object arg, oldval;
1202 struct x_output *x = f->output_data.x;
1203 unsigned long bg;
1205 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1206 unload_color (f, x->background_pixel);
1207 x->background_pixel = bg;
1209 if (FRAME_X_WINDOW (f) != 0)
1211 Display *dpy = FRAME_X_DISPLAY (f);
1213 BLOCK_INPUT;
1214 XSetBackground (dpy, x->normal_gc, bg);
1215 XSetForeground (dpy, x->reverse_gc, bg);
1216 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1217 XSetForeground (dpy, x->cursor_gc, bg);
1219 #ifdef USE_GTK
1220 xg_set_background_color (f, bg);
1221 #endif
1223 #ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1224 toolkit scroll bars. */
1226 Lisp_Object bar;
1227 for (bar = FRAME_SCROLL_BARS (f);
1228 !NILP (bar);
1229 bar = XSCROLL_BAR (bar)->next)
1231 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1232 XSetWindowBackground (dpy, window, bg);
1235 #endif /* USE_TOOLKIT_SCROLL_BARS */
1237 UNBLOCK_INPUT;
1238 update_face_from_frame_parameter (f, Qbackground_color, arg);
1240 if (FRAME_VISIBLE_P (f))
1241 redraw_frame (f);
1245 void
1246 x_set_mouse_color (f, arg, oldval)
1247 struct frame *f;
1248 Lisp_Object arg, oldval;
1250 struct x_output *x = f->output_data.x;
1251 Display *dpy = FRAME_X_DISPLAY (f);
1252 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1253 Cursor hourglass_cursor, horizontal_drag_cursor;
1254 int count;
1255 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1256 unsigned long mask_color = x->background_pixel;
1258 /* Don't let pointers be invisible. */
1259 if (mask_color == pixel)
1261 x_free_colors (f, &pixel, 1);
1262 pixel = x_copy_color (f, x->foreground_pixel);
1265 unload_color (f, x->mouse_pixel);
1266 x->mouse_pixel = pixel;
1268 BLOCK_INPUT;
1270 /* It's not okay to crash if the user selects a screwy cursor. */
1271 count = x_catch_errors (dpy);
1273 if (!NILP (Vx_pointer_shape))
1275 CHECK_NUMBER (Vx_pointer_shape);
1276 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
1278 else
1279 cursor = XCreateFontCursor (dpy, XC_xterm);
1280 x_check_errors (dpy, "bad text pointer cursor: %s");
1282 if (!NILP (Vx_nontext_pointer_shape))
1284 CHECK_NUMBER (Vx_nontext_pointer_shape);
1285 nontext_cursor
1286 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
1288 else
1289 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1290 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1292 if (!NILP (Vx_hourglass_pointer_shape))
1294 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1295 hourglass_cursor
1296 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
1298 else
1299 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1300 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
1302 if (!NILP (Vx_mode_pointer_shape))
1304 CHECK_NUMBER (Vx_mode_pointer_shape);
1305 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
1307 else
1308 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1309 x_check_errors (dpy, "bad modeline pointer cursor: %s");
1311 if (!NILP (Vx_sensitive_text_pointer_shape))
1313 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1314 hand_cursor
1315 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
1317 else
1318 hand_cursor = XCreateFontCursor (dpy, XC_hand2);
1320 if (!NILP (Vx_window_horizontal_drag_shape))
1322 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1323 horizontal_drag_cursor
1324 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
1326 else
1327 horizontal_drag_cursor
1328 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
1330 /* Check and report errors with the above calls. */
1331 x_check_errors (dpy, "can't set cursor shape: %s");
1332 x_uncatch_errors (dpy, count);
1335 XColor fore_color, back_color;
1337 fore_color.pixel = x->mouse_pixel;
1338 x_query_color (f, &fore_color);
1339 back_color.pixel = mask_color;
1340 x_query_color (f, &back_color);
1342 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1343 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1344 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1345 XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
1346 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1347 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
1350 if (FRAME_X_WINDOW (f) != 0)
1351 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1353 if (cursor != x->text_cursor
1354 && x->text_cursor != 0)
1355 XFreeCursor (dpy, x->text_cursor);
1356 x->text_cursor = cursor;
1358 if (nontext_cursor != x->nontext_cursor
1359 && x->nontext_cursor != 0)
1360 XFreeCursor (dpy, x->nontext_cursor);
1361 x->nontext_cursor = nontext_cursor;
1363 if (hourglass_cursor != x->hourglass_cursor
1364 && x->hourglass_cursor != 0)
1365 XFreeCursor (dpy, x->hourglass_cursor);
1366 x->hourglass_cursor = hourglass_cursor;
1368 if (mode_cursor != x->modeline_cursor
1369 && x->modeline_cursor != 0)
1370 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1371 x->modeline_cursor = mode_cursor;
1373 if (hand_cursor != x->hand_cursor
1374 && x->hand_cursor != 0)
1375 XFreeCursor (dpy, x->hand_cursor);
1376 x->hand_cursor = hand_cursor;
1378 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1379 && x->horizontal_drag_cursor != 0)
1380 XFreeCursor (dpy, x->horizontal_drag_cursor);
1381 x->horizontal_drag_cursor = horizontal_drag_cursor;
1383 XFlush (dpy);
1384 UNBLOCK_INPUT;
1386 update_face_from_frame_parameter (f, Qmouse_color, arg);
1389 void
1390 x_set_cursor_color (f, arg, oldval)
1391 struct frame *f;
1392 Lisp_Object arg, oldval;
1394 unsigned long fore_pixel, pixel;
1395 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
1396 struct x_output *x = f->output_data.x;
1398 if (!NILP (Vx_cursor_fore_pixel))
1400 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1401 WHITE_PIX_DEFAULT (f));
1402 fore_pixel_allocated_p = 1;
1404 else
1405 fore_pixel = x->background_pixel;
1407 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1408 pixel_allocated_p = 1;
1410 /* Make sure that the cursor color differs from the background color. */
1411 if (pixel == x->background_pixel)
1413 if (pixel_allocated_p)
1415 x_free_colors (f, &pixel, 1);
1416 pixel_allocated_p = 0;
1419 pixel = x->mouse_pixel;
1420 if (pixel == fore_pixel)
1422 if (fore_pixel_allocated_p)
1424 x_free_colors (f, &fore_pixel, 1);
1425 fore_pixel_allocated_p = 0;
1427 fore_pixel = x->background_pixel;
1431 unload_color (f, x->cursor_foreground_pixel);
1432 if (!fore_pixel_allocated_p)
1433 fore_pixel = x_copy_color (f, fore_pixel);
1434 x->cursor_foreground_pixel = fore_pixel;
1436 unload_color (f, x->cursor_pixel);
1437 if (!pixel_allocated_p)
1438 pixel = x_copy_color (f, pixel);
1439 x->cursor_pixel = pixel;
1441 if (FRAME_X_WINDOW (f) != 0)
1443 BLOCK_INPUT;
1444 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1445 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
1446 UNBLOCK_INPUT;
1448 if (FRAME_VISIBLE_P (f))
1450 x_update_cursor (f, 0);
1451 x_update_cursor (f, 1);
1455 update_face_from_frame_parameter (f, Qcursor_color, arg);
1458 /* Set the border-color of frame F to pixel value PIX.
1459 Note that this does not fully take effect if done before
1460 F has an x-window. */
1462 void
1463 x_set_border_pixel (f, pix)
1464 struct frame *f;
1465 int pix;
1467 unload_color (f, f->output_data.x->border_pixel);
1468 f->output_data.x->border_pixel = pix;
1470 if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
1472 BLOCK_INPUT;
1473 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1474 (unsigned long)pix);
1475 UNBLOCK_INPUT;
1477 if (FRAME_VISIBLE_P (f))
1478 redraw_frame (f);
1482 /* Set the border-color of frame F to value described by ARG.
1483 ARG can be a string naming a color.
1484 The border-color is used for the border that is drawn by the X server.
1485 Note that this does not fully take effect if done before
1486 F has an x-window; it must be redone when the window is created.
1488 Note: this is done in two routines because of the way X10 works.
1490 Note: under X11, this is normally the province of the window manager,
1491 and so emacs' border colors may be overridden. */
1493 void
1494 x_set_border_color (f, arg, oldval)
1495 struct frame *f;
1496 Lisp_Object arg, oldval;
1498 int pix;
1500 CHECK_STRING (arg);
1501 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1502 x_set_border_pixel (f, pix);
1503 update_face_from_frame_parameter (f, Qborder_color, arg);
1507 void
1508 x_set_cursor_type (f, arg, oldval)
1509 FRAME_PTR f;
1510 Lisp_Object arg, oldval;
1512 set_frame_cursor_types (f, arg);
1514 /* Make sure the cursor gets redrawn. */
1515 cursor_type_changed = 1;
1518 void
1519 x_set_icon_type (f, arg, oldval)
1520 struct frame *f;
1521 Lisp_Object arg, oldval;
1523 int result;
1525 if (STRINGP (arg))
1527 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1528 return;
1530 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1531 return;
1533 BLOCK_INPUT;
1534 if (NILP (arg))
1535 result = x_text_icon (f,
1536 (char *) SDATA ((!NILP (f->icon_name)
1537 ? f->icon_name
1538 : f->name)));
1539 else
1540 result = x_bitmap_icon (f, arg);
1542 if (result)
1544 UNBLOCK_INPUT;
1545 error ("No icon window available");
1548 XFlush (FRAME_X_DISPLAY (f));
1549 UNBLOCK_INPUT;
1552 void
1553 x_set_icon_name (f, arg, oldval)
1554 struct frame *f;
1555 Lisp_Object arg, oldval;
1557 int result;
1559 if (STRINGP (arg))
1561 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1562 return;
1564 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1565 return;
1567 f->icon_name = arg;
1569 if (f->output_data.x->icon_bitmap != 0)
1570 return;
1572 BLOCK_INPUT;
1574 result = x_text_icon (f,
1575 (char *) SDATA ((!NILP (f->icon_name)
1576 ? f->icon_name
1577 : !NILP (f->title)
1578 ? f->title
1579 : f->name)));
1581 if (result)
1583 UNBLOCK_INPUT;
1584 error ("No icon window available");
1587 XFlush (FRAME_X_DISPLAY (f));
1588 UNBLOCK_INPUT;
1592 void
1593 x_set_menu_bar_lines (f, value, oldval)
1594 struct frame *f;
1595 Lisp_Object value, oldval;
1597 int nlines;
1598 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
1599 int olines = FRAME_MENU_BAR_LINES (f);
1600 #endif
1602 /* Right now, menu bars don't work properly in minibuf-only frames;
1603 most of the commands try to apply themselves to the minibuffer
1604 frame itself, and get an error because you can't switch buffers
1605 in or split the minibuffer window. */
1606 if (FRAME_MINIBUF_ONLY_P (f))
1607 return;
1609 if (INTEGERP (value))
1610 nlines = XINT (value);
1611 else
1612 nlines = 0;
1614 /* Make sure we redisplay all windows in this frame. */
1615 windows_or_buffers_changed++;
1617 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1618 FRAME_MENU_BAR_LINES (f) = 0;
1619 if (nlines)
1621 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1622 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1623 /* Make sure next redisplay shows the menu bar. */
1624 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1626 else
1628 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1629 free_frame_menubar (f);
1630 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1631 if (FRAME_X_P (f))
1632 f->output_data.x->menubar_widget = 0;
1634 #else /* not USE_X_TOOLKIT && not USE_GTK */
1635 FRAME_MENU_BAR_LINES (f) = nlines;
1636 change_window_heights (f->root_window, nlines - olines);
1637 #endif /* not USE_X_TOOLKIT */
1638 adjust_glyphs (f);
1642 /* Set the number of lines used for the tool bar of frame F to VALUE.
1643 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1644 is the old number of tool bar lines. This function changes the
1645 height of all windows on frame F to match the new tool bar height.
1646 The frame's height doesn't change. */
1648 void
1649 x_set_tool_bar_lines (f, value, oldval)
1650 struct frame *f;
1651 Lisp_Object value, oldval;
1653 int delta, nlines, root_height;
1654 Lisp_Object root_window;
1656 /* Treat tool bars like menu bars. */
1657 if (FRAME_MINIBUF_ONLY_P (f))
1658 return;
1660 /* Use VALUE only if an integer >= 0. */
1661 if (INTEGERP (value) && XINT (value) >= 0)
1662 nlines = XFASTINT (value);
1663 else
1664 nlines = 0;
1666 #ifdef USE_GTK
1667 FRAME_TOOL_BAR_LINES (f) = 0;
1668 if (nlines)
1670 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
1671 if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
1672 /* Make sure next redisplay shows the tool bar. */
1673 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1674 update_frame_tool_bar (f);
1676 else
1678 if (FRAME_EXTERNAL_TOOL_BAR (f))
1679 free_frame_tool_bar (f);
1680 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
1683 return;
1684 #endif
1686 /* Make sure we redisplay all windows in this frame. */
1687 ++windows_or_buffers_changed;
1689 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1691 /* Don't resize the tool-bar to more than we have room for. */
1692 root_window = FRAME_ROOT_WINDOW (f);
1693 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1694 if (root_height - delta < 1)
1696 delta = root_height - 1;
1697 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1700 FRAME_TOOL_BAR_LINES (f) = nlines;
1701 change_window_heights (root_window, delta);
1702 adjust_glyphs (f);
1704 /* We also have to make sure that the internal border at the top of
1705 the frame, below the menu bar or tool bar, is redrawn when the
1706 tool bar disappears. This is so because the internal border is
1707 below the tool bar if one is displayed, but is below the menu bar
1708 if there isn't a tool bar. The tool bar draws into the area
1709 below the menu bar. */
1710 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1712 updating_frame = f;
1713 clear_frame ();
1714 clear_current_matrices (f);
1715 updating_frame = NULL;
1718 /* If the tool bar gets smaller, the internal border below it
1719 has to be cleared. It was formerly part of the display
1720 of the larger tool bar, and updating windows won't clear it. */
1721 if (delta < 0)
1723 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1724 int width = FRAME_PIXEL_WIDTH (f);
1725 int y = nlines * FRAME_LINE_HEIGHT (f);
1727 BLOCK_INPUT;
1728 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1729 0, y, width, height, False);
1730 UNBLOCK_INPUT;
1732 if (WINDOWP (f->tool_bar_window))
1733 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1738 /* Set the foreground color for scroll bars on frame F to VALUE.
1739 VALUE should be a string, a color name. If it isn't a string or
1740 isn't a valid color name, do nothing. OLDVAL is the old value of
1741 the frame parameter. */
1743 void
1744 x_set_scroll_bar_foreground (f, value, oldval)
1745 struct frame *f;
1746 Lisp_Object value, oldval;
1748 unsigned long pixel;
1750 if (STRINGP (value))
1751 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1752 else
1753 pixel = -1;
1755 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1756 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1758 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1759 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1761 /* Remove all scroll bars because they have wrong colors. */
1762 if (condemn_scroll_bars_hook)
1763 (*condemn_scroll_bars_hook) (f);
1764 if (judge_scroll_bars_hook)
1765 (*judge_scroll_bars_hook) (f);
1767 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
1768 redraw_frame (f);
1773 /* Set the background color for scroll bars on frame F to VALUE VALUE
1774 should be a string, a color name. If it isn't a string or isn't a
1775 valid color name, do nothing. OLDVAL is the old value of the frame
1776 parameter. */
1778 void
1779 x_set_scroll_bar_background (f, value, oldval)
1780 struct frame *f;
1781 Lisp_Object value, oldval;
1783 unsigned long pixel;
1785 if (STRINGP (value))
1786 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
1787 else
1788 pixel = -1;
1790 if (f->output_data.x->scroll_bar_background_pixel != -1)
1791 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
1793 #ifdef USE_TOOLKIT_SCROLL_BARS
1794 /* Scrollbar shadow colors. */
1795 if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
1797 unload_color (f, f->output_data.x->scroll_bar_top_shadow_pixel);
1798 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
1800 if (f->output_data.x->scroll_bar_bottom_shadow_pixel != -1)
1802 unload_color (f, f->output_data.x->scroll_bar_bottom_shadow_pixel);
1803 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
1805 #endif /* USE_TOOLKIT_SCROLL_BARS */
1807 f->output_data.x->scroll_bar_background_pixel = pixel;
1808 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1810 /* Remove all scroll bars because they have wrong colors. */
1811 if (condemn_scroll_bars_hook)
1812 (*condemn_scroll_bars_hook) (f);
1813 if (judge_scroll_bars_hook)
1814 (*judge_scroll_bars_hook) (f);
1816 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
1817 redraw_frame (f);
1822 /* Encode Lisp string STRING as a text in a format appropriate for
1823 XICCC (X Inter Client Communication Conventions).
1825 If STRING contains only ASCII characters, do no conversion and
1826 return the string data of STRING. Otherwise, encode the text by
1827 CODING_SYSTEM, and return a newly allocated memory area which
1828 should be freed by `xfree' by a caller.
1830 SELECTIONP non-zero means the string is being encoded for an X
1831 selection, so it is safe to run pre-write conversions (which
1832 may run Lisp code).
1834 Store the byte length of resulting text in *TEXT_BYTES.
1836 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
1837 which means that the `encoding' of the result can be `STRING'.
1838 Otherwise store 0 in *STRINGP, which means that the `encoding' of
1839 the result should be `COMPOUND_TEXT'. */
1841 unsigned char *
1842 x_encode_text (string, coding_system, selectionp, text_bytes, stringp)
1843 Lisp_Object string, coding_system;
1844 int *text_bytes, *stringp;
1845 int selectionp;
1847 unsigned char *str = SDATA (string);
1848 int chars = SCHARS (string);
1849 int bytes = SBYTES (string);
1850 int charset_info;
1851 int bufsize;
1852 unsigned char *buf;
1853 struct coding_system coding;
1854 extern Lisp_Object Qcompound_text_with_extensions;
1856 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
1857 if (charset_info == 0)
1859 /* No multibyte character in OBJ. We need not encode it. */
1860 *text_bytes = bytes;
1861 *stringp = 1;
1862 return str;
1865 setup_coding_system (coding_system, &coding);
1866 if (selectionp
1867 && SYMBOLP (coding.pre_write_conversion)
1868 && !NILP (Ffboundp (coding.pre_write_conversion)))
1870 string = run_pre_post_conversion_on_str (string, &coding, 1);
1871 str = SDATA (string);
1872 chars = SCHARS (string);
1873 bytes = SBYTES (string);
1875 coding.src_multibyte = 1;
1876 coding.dst_multibyte = 0;
1877 coding.mode |= CODING_MODE_LAST_BLOCK;
1878 if (coding.type == coding_type_iso2022)
1879 coding.flags |= CODING_FLAG_ISO_SAFE;
1880 /* We suppress producing escape sequences for composition. */
1881 coding.composing = COMPOSITION_DISABLED;
1882 bufsize = encoding_buffer_size (&coding, bytes);
1883 buf = (unsigned char *) xmalloc (bufsize);
1884 encode_coding (&coding, str, buf, bytes, bufsize);
1885 *text_bytes = coding.produced;
1886 *stringp = (charset_info == 1
1887 || (!EQ (coding_system, Qcompound_text)
1888 && !EQ (coding_system, Qcompound_text_with_extensions)));
1889 return buf;
1893 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1894 x_id_name.
1896 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1897 name; if NAME is a string, set F's name to NAME and set
1898 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1900 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1901 suggesting a new name, which lisp code should override; if
1902 F->explicit_name is set, ignore the new name; otherwise, set it. */
1904 void
1905 x_set_name (f, name, explicit)
1906 struct frame *f;
1907 Lisp_Object name;
1908 int explicit;
1910 /* Make sure that requests from lisp code override requests from
1911 Emacs redisplay code. */
1912 if (explicit)
1914 /* If we're switching from explicit to implicit, we had better
1915 update the mode lines and thereby update the title. */
1916 if (f->explicit_name && NILP (name))
1917 update_mode_lines = 1;
1919 f->explicit_name = ! NILP (name);
1921 else if (f->explicit_name)
1922 return;
1924 /* If NAME is nil, set the name to the x_id_name. */
1925 if (NILP (name))
1927 /* Check for no change needed in this very common case
1928 before we do any consing. */
1929 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
1930 SDATA (f->name)))
1931 return;
1932 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
1934 else
1935 CHECK_STRING (name);
1937 /* Don't change the name if it's already NAME. */
1938 if (! NILP (Fstring_equal (name, f->name)))
1939 return;
1941 f->name = name;
1943 /* For setting the frame title, the title parameter should override
1944 the name parameter. */
1945 if (! NILP (f->title))
1946 name = f->title;
1948 if (FRAME_X_WINDOW (f))
1950 BLOCK_INPUT;
1951 #ifdef HAVE_X11R4
1953 XTextProperty text, icon;
1954 int bytes, stringp;
1955 Lisp_Object coding_system;
1957 /* Note: Encoding strategy
1959 We encode NAME by compound-text and use "COMPOUND-TEXT" in
1960 text.encoding. But, there are non-internationalized window
1961 managers which don't support that encoding. So, if NAME
1962 contains only ASCII and 8859-1 characters, encode it by
1963 iso-latin-1, and use "STRING" in text.encoding hoping that
1964 such window managers at least analyze this format correctly,
1965 i.e. treat 8-bit bytes as 8859-1 characters.
1967 We may also be able to use "UTF8_STRING" in text.encoding
1968 in the future which can encode all Unicode characters.
1969 But, for the moment, there's no way to know that the
1970 current window manager supports it or not. */
1971 coding_system = Qcompound_text;
1972 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
1973 text.encoding = (stringp ? XA_STRING
1974 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1975 text.format = 8;
1976 text.nitems = bytes;
1978 if (NILP (f->icon_name))
1980 icon = text;
1982 else
1984 /* See the above comment "Note: Encoding strategy". */
1985 icon.value = x_encode_text (f->icon_name, coding_system, 0,
1986 &bytes, &stringp);
1987 icon.encoding = (stringp ? XA_STRING
1988 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
1989 icon.format = 8;
1990 icon.nitems = bytes;
1992 #ifdef USE_GTK
1993 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
1994 SDATA (name));
1995 #else /* not USE_GTK */
1996 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
1997 #endif /* not USE_GTK */
1999 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
2001 if (!NILP (f->icon_name)
2002 && icon.value != (unsigned char *) SDATA (f->icon_name))
2003 xfree (icon.value);
2004 if (text.value != (unsigned char *) SDATA (name))
2005 xfree (text.value);
2007 #else /* not HAVE_X11R4 */
2008 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2009 SDATA (name));
2010 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2011 SDATA (name));
2012 #endif /* not HAVE_X11R4 */
2013 UNBLOCK_INPUT;
2017 /* This function should be called when the user's lisp code has
2018 specified a name for the frame; the name will override any set by the
2019 redisplay code. */
2020 void
2021 x_explicitly_set_name (f, arg, oldval)
2022 FRAME_PTR f;
2023 Lisp_Object arg, oldval;
2025 x_set_name (f, arg, 1);
2028 /* This function should be called by Emacs redisplay code to set the
2029 name; names set this way will never override names set by the user's
2030 lisp code. */
2031 void
2032 x_implicitly_set_name (f, arg, oldval)
2033 FRAME_PTR f;
2034 Lisp_Object arg, oldval;
2036 x_set_name (f, arg, 0);
2039 /* Change the title of frame F to NAME.
2040 If NAME is nil, use the frame name as the title.
2042 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2043 name; if NAME is a string, set F's name to NAME and set
2044 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2046 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2047 suggesting a new name, which lisp code should override; if
2048 F->explicit_name is set, ignore the new name; otherwise, set it. */
2050 void
2051 x_set_title (f, name, old_name)
2052 struct frame *f;
2053 Lisp_Object name, old_name;
2055 /* Don't change the title if it's already NAME. */
2056 if (EQ (name, f->title))
2057 return;
2059 update_mode_lines = 1;
2061 f->title = name;
2063 if (NILP (name))
2064 name = f->name;
2065 else
2066 CHECK_STRING (name);
2068 if (FRAME_X_WINDOW (f))
2070 BLOCK_INPUT;
2071 #ifdef HAVE_X11R4
2073 XTextProperty text, icon;
2074 int bytes, stringp;
2075 Lisp_Object coding_system;
2077 coding_system = Qcompound_text;
2078 /* See the comment "Note: Encoding strategy" in x_set_name. */
2079 text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
2080 text.encoding = (stringp ? XA_STRING
2081 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2082 text.format = 8;
2083 text.nitems = bytes;
2085 if (NILP (f->icon_name))
2087 icon = text;
2089 else
2091 /* See the comment "Note: Encoding strategy" in x_set_name. */
2092 icon.value = x_encode_text (f->icon_name, coding_system, 0,
2093 &bytes, &stringp);
2094 icon.encoding = (stringp ? XA_STRING
2095 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2096 icon.format = 8;
2097 icon.nitems = bytes;
2100 #ifdef USE_GTK
2101 gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
2102 SDATA (name));
2103 #else /* not USE_GTK */
2104 XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
2105 #endif /* not USE_GTK */
2107 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
2108 &icon);
2110 if (!NILP (f->icon_name)
2111 && icon.value != (unsigned char *) SDATA (f->icon_name))
2112 xfree (icon.value);
2113 if (text.value != (unsigned char *) SDATA (name))
2114 xfree (text.value);
2116 #else /* not HAVE_X11R4 */
2117 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2118 SDATA (name));
2119 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2120 SDATA (name));
2121 #endif /* not HAVE_X11R4 */
2122 UNBLOCK_INPUT;
2126 void
2127 x_set_scroll_bar_default_width (f)
2128 struct frame *f;
2130 int wid = FRAME_COLUMN_WIDTH (f);
2132 #ifdef USE_TOOLKIT_SCROLL_BARS
2133 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2134 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2135 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2136 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
2137 #else
2138 /* Make the actual width at least 14 pixels and a multiple of a
2139 character width. */
2140 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2142 /* Use all of that space (aside from required margins) for the
2143 scroll bar. */
2144 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
2145 #endif
2149 /* Record in frame F the specified or default value according to ALIST
2150 of the parameter named PROP (a Lisp symbol). If no value is
2151 specified for PROP, look for an X default for XPROP on the frame
2152 named NAME. If that is not found either, use the value DEFLT. */
2154 static Lisp_Object
2155 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2156 foreground_p)
2157 struct frame *f;
2158 Lisp_Object alist;
2159 Lisp_Object prop;
2160 char *xprop;
2161 char *xclass;
2162 int foreground_p;
2164 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2165 Lisp_Object tem;
2167 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2168 if (EQ (tem, Qunbound))
2170 #ifdef USE_TOOLKIT_SCROLL_BARS
2172 /* See if an X resource for the scroll bar color has been
2173 specified. */
2174 tem = display_x_get_resource (dpyinfo,
2175 build_string (foreground_p
2176 ? "foreground"
2177 : "background"),
2178 empty_string,
2179 build_string ("verticalScrollBar"),
2180 empty_string);
2181 if (!STRINGP (tem))
2183 /* If nothing has been specified, scroll bars will use a
2184 toolkit-dependent default. Because these defaults are
2185 difficult to get at without actually creating a scroll
2186 bar, use nil to indicate that no color has been
2187 specified. */
2188 tem = Qnil;
2191 #else /* not USE_TOOLKIT_SCROLL_BARS */
2193 tem = Qnil;
2195 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2198 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2199 return tem;
2204 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2206 Status
2207 XSetWMProtocols (dpy, w, protocols, count)
2208 Display *dpy;
2209 Window w;
2210 Atom *protocols;
2211 int count;
2213 Atom prop;
2214 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2215 if (prop == None) return False;
2216 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2217 (unsigned char *) protocols, count);
2218 return True;
2220 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2222 #ifdef USE_X_TOOLKIT
2224 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2225 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2226 already be present because of the toolkit (Motif adds some of them,
2227 for example, but Xt doesn't). */
2229 static void
2230 hack_wm_protocols (f, widget)
2231 FRAME_PTR f;
2232 Widget widget;
2234 Display *dpy = XtDisplay (widget);
2235 Window w = XtWindow (widget);
2236 int need_delete = 1;
2237 int need_focus = 1;
2238 int need_save = 1;
2240 BLOCK_INPUT;
2242 Atom type, *atoms = 0;
2243 int format = 0;
2244 unsigned long nitems = 0;
2245 unsigned long bytes_after;
2247 if ((XGetWindowProperty (dpy, w,
2248 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2249 (long)0, (long)100, False, XA_ATOM,
2250 &type, &format, &nitems, &bytes_after,
2251 (unsigned char **) &atoms)
2252 == Success)
2253 && format == 32 && type == XA_ATOM)
2254 while (nitems > 0)
2256 nitems--;
2257 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
2258 need_delete = 0;
2259 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
2260 need_focus = 0;
2261 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
2262 need_save = 0;
2264 if (atoms) XFree ((char *) atoms);
2267 Atom props [10];
2268 int count = 0;
2269 if (need_delete)
2270 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2271 if (need_focus)
2272 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
2273 if (need_save)
2274 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2275 if (count)
2276 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2277 XA_ATOM, 32, PropModeAppend,
2278 (unsigned char *) props, count);
2280 UNBLOCK_INPUT;
2282 #endif
2286 /* Support routines for XIC (X Input Context). */
2288 #ifdef HAVE_X_I18N
2290 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
2291 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
2294 /* Supported XIM styles, ordered by preference. */
2296 static XIMStyle supported_xim_styles[] =
2298 XIMPreeditPosition | XIMStatusArea,
2299 XIMPreeditPosition | XIMStatusNothing,
2300 XIMPreeditPosition | XIMStatusNone,
2301 XIMPreeditNothing | XIMStatusArea,
2302 XIMPreeditNothing | XIMStatusNothing,
2303 XIMPreeditNothing | XIMStatusNone,
2304 XIMPreeditNone | XIMStatusArea,
2305 XIMPreeditNone | XIMStatusNothing,
2306 XIMPreeditNone | XIMStatusNone,
2311 /* Create an X fontset on frame F with base font name
2312 BASE_FONTNAME.. */
2314 static XFontSet
2315 xic_create_xfontset (f, base_fontname)
2316 struct frame *f;
2317 char *base_fontname;
2319 XFontSet xfs;
2320 char **missing_list;
2321 int missing_count;
2322 char *def_string;
2324 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
2325 base_fontname, &missing_list,
2326 &missing_count, &def_string);
2327 if (missing_list)
2328 XFreeStringList (missing_list);
2330 /* No need to free def_string. */
2331 return xfs;
2335 /* Value is the best input style, given user preferences USER (already
2336 checked to be supported by Emacs), and styles supported by the
2337 input method XIM. */
2339 static XIMStyle
2340 best_xim_style (user, xim)
2341 XIMStyles *user;
2342 XIMStyles *xim;
2344 int i, j;
2346 for (i = 0; i < user->count_styles; ++i)
2347 for (j = 0; j < xim->count_styles; ++j)
2348 if (user->supported_styles[i] == xim->supported_styles[j])
2349 return user->supported_styles[i];
2351 /* Return the default style. */
2352 return XIMPreeditNothing | XIMStatusNothing;
2355 /* Create XIC for frame F. */
2357 static XIMStyle xic_style;
2359 void
2360 create_frame_xic (f)
2361 struct frame *f;
2363 XIM xim;
2364 XIC xic = NULL;
2365 XFontSet xfs = NULL;
2367 if (FRAME_XIC (f))
2368 return;
2370 xim = FRAME_X_XIM (f);
2371 if (xim)
2373 XRectangle s_area;
2374 XPoint spot;
2375 XVaNestedList preedit_attr;
2376 XVaNestedList status_attr;
2377 char *base_fontname;
2378 int fontset;
2380 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
2381 spot.x = 0; spot.y = 1;
2382 /* Create X fontset. */
2383 fontset = FRAME_FONTSET (f);
2384 if (fontset < 0)
2385 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2386 else
2388 /* Determine the base fontname from the ASCII font name of
2389 FONTSET. */
2390 char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
2391 char *p = ascii_font;
2392 int i;
2394 for (i = 0; *p; p++)
2395 if (*p == '-') i++;
2396 if (i != 14)
2397 /* As the font name doesn't conform to XLFD, we can't
2398 modify it to get a suitable base fontname for the
2399 frame. */
2400 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
2401 else
2403 int len = strlen (ascii_font) + 1;
2404 char *p1 = NULL;
2406 for (i = 0, p = ascii_font; i < 8; p++)
2408 if (*p == '-')
2410 i++;
2411 if (i == 3)
2412 p1 = p + 1;
2415 base_fontname = (char *) alloca (len);
2416 bzero (base_fontname, len);
2417 strcpy (base_fontname, "-*-*-");
2418 bcopy (p1, base_fontname + 5, p - p1);
2419 strcat (base_fontname, "*-*-*-*-*-*-*");
2422 xfs = xic_create_xfontset (f, base_fontname);
2424 /* Determine XIC style. */
2425 if (xic_style == 0)
2427 XIMStyles supported_list;
2428 supported_list.count_styles = (sizeof supported_xim_styles
2429 / sizeof supported_xim_styles[0]);
2430 supported_list.supported_styles = supported_xim_styles;
2431 xic_style = best_xim_style (&supported_list,
2432 FRAME_X_XIM_STYLES (f));
2435 preedit_attr = XVaCreateNestedList (0,
2436 XNFontSet, xfs,
2437 XNForeground,
2438 FRAME_FOREGROUND_PIXEL (f),
2439 XNBackground,
2440 FRAME_BACKGROUND_PIXEL (f),
2441 (xic_style & XIMPreeditPosition
2442 ? XNSpotLocation
2443 : NULL),
2444 &spot,
2445 NULL);
2446 status_attr = XVaCreateNestedList (0,
2447 XNArea,
2448 &s_area,
2449 XNFontSet,
2450 xfs,
2451 XNForeground,
2452 FRAME_FOREGROUND_PIXEL (f),
2453 XNBackground,
2454 FRAME_BACKGROUND_PIXEL (f),
2455 NULL);
2457 xic = XCreateIC (xim,
2458 XNInputStyle, xic_style,
2459 XNClientWindow, FRAME_X_WINDOW (f),
2460 XNFocusWindow, FRAME_X_WINDOW (f),
2461 XNStatusAttributes, status_attr,
2462 XNPreeditAttributes, preedit_attr,
2463 NULL);
2464 XFree (preedit_attr);
2465 XFree (status_attr);
2468 FRAME_XIC (f) = xic;
2469 FRAME_XIC_STYLE (f) = xic_style;
2470 FRAME_XIC_FONTSET (f) = xfs;
2474 /* Destroy XIC and free XIC fontset of frame F, if any. */
2476 void
2477 free_frame_xic (f)
2478 struct frame *f;
2480 if (FRAME_XIC (f) == NULL)
2481 return;
2483 XDestroyIC (FRAME_XIC (f));
2484 if (FRAME_XIC_FONTSET (f))
2485 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2487 FRAME_XIC (f) = NULL;
2488 FRAME_XIC_FONTSET (f) = NULL;
2492 /* Place preedit area for XIC of window W's frame to specified
2493 pixel position X/Y. X and Y are relative to window W. */
2495 void
2496 xic_set_preeditarea (w, x, y)
2497 struct window *w;
2498 int x, y;
2500 struct frame *f = XFRAME (w->frame);
2501 XVaNestedList attr;
2502 XPoint spot;
2504 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
2505 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
2506 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
2507 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2508 XFree (attr);
2512 /* Place status area for XIC in bottom right corner of frame F.. */
2514 void
2515 xic_set_statusarea (f)
2516 struct frame *f;
2518 XIC xic = FRAME_XIC (f);
2519 XVaNestedList attr;
2520 XRectangle area;
2521 XRectangle *needed;
2523 /* Negotiate geometry of status area. If input method has existing
2524 status area, use its current size. */
2525 area.x = area.y = area.width = area.height = 0;
2526 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
2527 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2528 XFree (attr);
2530 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
2531 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2532 XFree (attr);
2534 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
2536 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
2537 XGetICValues (xic, XNStatusAttributes, attr, NULL);
2538 XFree (attr);
2541 area.width = needed->width;
2542 area.height = needed->height;
2543 area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
2544 area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
2545 - FRAME_MENUBAR_HEIGHT (f)
2546 - FRAME_TOOLBAR_HEIGHT (f)
2547 - FRAME_INTERNAL_BORDER_WIDTH (f));
2548 XFree (needed);
2550 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
2551 XSetICValues (xic, XNStatusAttributes, attr, NULL);
2552 XFree (attr);
2556 /* Set X fontset for XIC of frame F, using base font name
2557 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
2559 void
2560 xic_set_xfontset (f, base_fontname)
2561 struct frame *f;
2562 char *base_fontname;
2564 XVaNestedList attr;
2565 XFontSet xfs;
2567 xfs = xic_create_xfontset (f, base_fontname);
2569 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
2570 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
2571 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
2572 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
2573 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
2574 XFree (attr);
2576 if (FRAME_XIC_FONTSET (f))
2577 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
2578 FRAME_XIC_FONTSET (f) = xfs;
2581 #endif /* HAVE_X_I18N */
2585 #ifdef USE_X_TOOLKIT
2587 /* Create and set up the X widget for frame F. */
2589 static void
2590 x_window (f, window_prompting, minibuffer_only)
2591 struct frame *f;
2592 long window_prompting;
2593 int minibuffer_only;
2595 XClassHint class_hints;
2596 XSetWindowAttributes attributes;
2597 unsigned long attribute_mask;
2598 Widget shell_widget;
2599 Widget pane_widget;
2600 Widget frame_widget;
2601 Arg al [25];
2602 int ac;
2604 BLOCK_INPUT;
2606 /* Use the resource name as the top-level widget name
2607 for looking up resources. Make a non-Lisp copy
2608 for the window manager, so GC relocation won't bother it.
2610 Elsewhere we specify the window name for the window manager. */
2613 char *str = (char *) SDATA (Vx_resource_name);
2614 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2615 strcpy (f->namebuf, str);
2618 ac = 0;
2619 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
2620 XtSetArg (al[ac], XtNinput, 1); ac++;
2621 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2622 XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
2623 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2624 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2625 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2626 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
2627 applicationShellWidgetClass,
2628 FRAME_X_DISPLAY (f), al, ac);
2630 f->output_data.x->widget = shell_widget;
2631 /* maybe_set_screen_title_format (shell_widget); */
2633 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
2634 (widget_value *) NULL,
2635 shell_widget, False,
2636 (lw_callback) NULL,
2637 (lw_callback) NULL,
2638 (lw_callback) NULL,
2639 (lw_callback) NULL);
2641 ac = 0;
2642 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2643 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2644 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2645 XtSetValues (pane_widget, al, ac);
2646 f->output_data.x->column_widget = pane_widget;
2648 /* mappedWhenManaged to false tells to the paned window to not map/unmap
2649 the emacs screen when changing menubar. This reduces flickering. */
2651 ac = 0;
2652 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
2653 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
2654 XtSetArg (al[ac], XtNallowResize, 1); ac++;
2655 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
2656 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
2657 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
2658 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
2659 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
2660 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
2661 al, ac);
2663 f->output_data.x->edit_widget = frame_widget;
2665 XtManageChild (frame_widget);
2667 /* Do some needed geometry management. */
2669 int len;
2670 char *tem, shell_position[32];
2671 Arg al[10];
2672 int ac = 0;
2673 int extra_borders = 0;
2674 int menubar_size
2675 = (f->output_data.x->menubar_widget
2676 ? (f->output_data.x->menubar_widget->core.height
2677 + f->output_data.x->menubar_widget->core.border_width)
2678 : 0);
2680 #if 0 /* Experimentally, we now get the right results
2681 for -geometry -0-0 without this. 24 Aug 96, rms. */
2682 if (FRAME_EXTERNAL_MENU_BAR (f))
2684 Dimension ibw = 0;
2685 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
2686 menubar_size += ibw;
2688 #endif
2690 f->output_data.x->menubar_height = menubar_size;
2692 #ifndef USE_LUCID
2693 /* Motif seems to need this amount added to the sizes
2694 specified for the shell widget. The Athena/Lucid widgets don't.
2695 Both conclusions reached experimentally. -- rms. */
2696 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
2697 &extra_borders, NULL);
2698 extra_borders *= 2;
2699 #endif
2701 /* Convert our geometry parameters into a geometry string
2702 and specify it.
2703 Note that we do not specify here whether the position
2704 is a user-specified or program-specified one.
2705 We pass that information later, in x_wm_set_size_hints. */
2707 int left = f->left_pos;
2708 int xneg = window_prompting & XNegative;
2709 int top = f->top_pos;
2710 int yneg = window_prompting & YNegative;
2711 if (xneg)
2712 left = -left;
2713 if (yneg)
2714 top = -top;
2716 if (window_prompting & USPosition)
2717 sprintf (shell_position, "=%dx%d%c%d%c%d",
2718 FRAME_PIXEL_WIDTH (f) + extra_borders,
2719 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
2720 (xneg ? '-' : '+'), left,
2721 (yneg ? '-' : '+'), top);
2722 else
2724 sprintf (shell_position, "=%dx%d",
2725 FRAME_PIXEL_WIDTH (f) + extra_borders,
2726 FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
2728 /* Setting x and y when the position is not specified in
2729 the geometry string will set program position in the WM hints.
2730 If Emacs had just one program position, we could set it in
2731 fallback resources, but since each make-frame call can specify
2732 different program positions, this is easier. */
2733 XtSetArg (al[ac], XtNx, left); ac++;
2734 XtSetArg (al[ac], XtNy, top); ac++;
2738 len = strlen (shell_position) + 1;
2739 /* We don't free this because we don't know whether
2740 it is safe to free it while the frame exists.
2741 It isn't worth the trouble of arranging to free it
2742 when the frame is deleted. */
2743 tem = (char *) xmalloc (len);
2744 strncpy (tem, shell_position, len);
2745 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2746 XtSetValues (shell_widget, al, ac);
2749 XtManageChild (pane_widget);
2750 XtRealizeWidget (shell_widget);
2752 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
2754 validate_x_resource_name ();
2756 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2757 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2758 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
2760 #ifdef HAVE_X_I18N
2761 FRAME_XIC (f) = NULL;
2762 if (use_xim)
2763 create_frame_xic (f);
2764 #endif
2766 f->output_data.x->wm_hints.input = True;
2767 f->output_data.x->wm_hints.flags |= InputHint;
2768 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2769 &f->output_data.x->wm_hints);
2771 hack_wm_protocols (f, shell_widget);
2773 #ifdef HACK_EDITRES
2774 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
2775 #endif
2777 /* Do a stupid property change to force the server to generate a
2778 PropertyNotify event so that the event_stream server timestamp will
2779 be initialized to something relevant to the time we created the window.
2781 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
2782 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
2783 XA_ATOM, 32, PropModeAppend,
2784 (unsigned char*) NULL, 0);
2786 /* Make all the standard events reach the Emacs frame. */
2787 attributes.event_mask = STANDARD_EVENT_SET;
2789 #ifdef HAVE_X_I18N
2790 if (FRAME_XIC (f))
2792 /* XIM server might require some X events. */
2793 unsigned long fevent = NoEventMask;
2794 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2795 attributes.event_mask |= fevent;
2797 #endif /* HAVE_X_I18N */
2799 attribute_mask = CWEventMask;
2800 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2801 attribute_mask, &attributes);
2803 XtMapWidget (frame_widget);
2805 /* x_set_name normally ignores requests to set the name if the
2806 requested name is the same as the current name. This is the one
2807 place where that assumption isn't correct; f->name is set, but
2808 the X server hasn't been told. */
2810 Lisp_Object name;
2811 int explicit = f->explicit_name;
2813 f->explicit_name = 0;
2814 name = f->name;
2815 f->name = Qnil;
2816 x_set_name (f, name, explicit);
2819 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2820 f->output_data.x->text_cursor);
2822 UNBLOCK_INPUT;
2824 /* This is a no-op, except under Motif. Make sure main areas are
2825 set to something reasonable, in case we get an error later. */
2826 lw_set_main_areas (pane_widget, 0, frame_widget);
2829 #else /* not USE_X_TOOLKIT */
2830 #ifdef USE_GTK
2831 void
2832 x_window (f)
2833 FRAME_PTR f;
2835 if (! xg_create_frame_widgets (f))
2836 error ("Unable to create window");
2838 #ifdef HAVE_X_I18N
2839 FRAME_XIC (f) = NULL;
2840 if (use_xim)
2842 BLOCK_INPUT;
2843 create_frame_xic (f);
2844 if (FRAME_XIC (f))
2846 /* XIM server might require some X events. */
2847 unsigned long fevent = NoEventMask;
2848 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2850 if (fevent != NoEventMask)
2852 XSetWindowAttributes attributes;
2853 XWindowAttributes wattr;
2854 unsigned long attribute_mask;
2856 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2857 &wattr);
2858 attributes.event_mask = wattr.your_event_mask | fevent;
2859 attribute_mask = CWEventMask;
2860 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2861 attribute_mask, &attributes);
2864 UNBLOCK_INPUT;
2866 #endif
2869 #else /*! USE_GTK */
2870 /* Create and set up the X window for frame F. */
2872 void
2873 x_window (f)
2874 struct frame *f;
2877 XClassHint class_hints;
2878 XSetWindowAttributes attributes;
2879 unsigned long attribute_mask;
2881 attributes.background_pixel = f->output_data.x->background_pixel;
2882 attributes.border_pixel = f->output_data.x->border_pixel;
2883 attributes.bit_gravity = StaticGravity;
2884 attributes.backing_store = NotUseful;
2885 attributes.save_under = True;
2886 attributes.event_mask = STANDARD_EVENT_SET;
2887 attributes.colormap = FRAME_X_COLORMAP (f);
2888 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
2889 | CWColormap);
2891 BLOCK_INPUT;
2892 FRAME_X_WINDOW (f)
2893 = XCreateWindow (FRAME_X_DISPLAY (f),
2894 f->output_data.x->parent_desc,
2895 f->left_pos,
2896 f->top_pos,
2897 FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
2898 f->border_width,
2899 CopyFromParent, /* depth */
2900 InputOutput, /* class */
2901 FRAME_X_VISUAL (f),
2902 attribute_mask, &attributes);
2904 #ifdef HAVE_X_I18N
2905 if (use_xim)
2907 create_frame_xic (f);
2908 if (FRAME_XIC (f))
2910 /* XIM server might require some X events. */
2911 unsigned long fevent = NoEventMask;
2912 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
2913 attributes.event_mask |= fevent;
2914 attribute_mask = CWEventMask;
2915 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2916 attribute_mask, &attributes);
2919 #endif /* HAVE_X_I18N */
2921 validate_x_resource_name ();
2923 class_hints.res_name = (char *) SDATA (Vx_resource_name);
2924 class_hints.res_class = (char *) SDATA (Vx_resource_class);
2925 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
2927 /* The menubar is part of the ordinary display;
2928 it does not count in addition to the height of the window. */
2929 f->output_data.x->menubar_height = 0;
2931 /* This indicates that we use the "Passive Input" input model.
2932 Unless we do this, we don't get the Focus{In,Out} events that we
2933 need to draw the cursor correctly. Accursed bureaucrats.
2934 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
2936 f->output_data.x->wm_hints.input = True;
2937 f->output_data.x->wm_hints.flags |= InputHint;
2938 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2939 &f->output_data.x->wm_hints);
2940 f->output_data.x->wm_hints.icon_pixmap = None;
2942 /* Request "save yourself" and "delete window" commands from wm. */
2944 Atom protocols[2];
2945 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
2946 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
2947 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
2950 /* x_set_name normally ignores requests to set the name if the
2951 requested name is the same as the current name. This is the one
2952 place where that assumption isn't correct; f->name is set, but
2953 the X server hasn't been told. */
2955 Lisp_Object name;
2956 int explicit = f->explicit_name;
2958 f->explicit_name = 0;
2959 name = f->name;
2960 f->name = Qnil;
2961 x_set_name (f, name, explicit);
2964 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2965 f->output_data.x->text_cursor);
2967 UNBLOCK_INPUT;
2969 if (FRAME_X_WINDOW (f) == 0)
2970 error ("Unable to create window");
2973 #endif /* not USE_GTK */
2974 #endif /* not USE_X_TOOLKIT */
2976 /* Handle the icon stuff for this window. Perhaps later we might
2977 want an x_set_icon_position which can be called interactively as
2978 well. */
2980 static void
2981 x_icon (f, parms)
2982 struct frame *f;
2983 Lisp_Object parms;
2985 Lisp_Object icon_x, icon_y;
2986 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2988 /* Set the position of the icon. Note that twm groups all
2989 icons in an icon window. */
2990 icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
2991 icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
2992 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2994 CHECK_NUMBER (icon_x);
2995 CHECK_NUMBER (icon_y);
2997 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2998 error ("Both left and top icon corners of icon must be specified");
3000 BLOCK_INPUT;
3002 if (! EQ (icon_x, Qunbound))
3003 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3005 /* Start up iconic or window? */
3006 x_wm_set_window_state
3007 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3008 Qicon)
3009 ? IconicState
3010 : NormalState));
3012 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
3013 ? f->icon_name
3014 : f->name)));
3016 UNBLOCK_INPUT;
3019 /* Make the GCs needed for this window, setting the
3020 background, border and mouse colors; also create the
3021 mouse cursor and the gray border tile. */
3023 static char cursor_bits[] =
3025 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3026 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3027 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3028 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3031 static void
3032 x_make_gc (f)
3033 struct frame *f;
3035 XGCValues gc_values;
3037 BLOCK_INPUT;
3039 /* Create the GCs of this frame.
3040 Note that many default values are used. */
3042 /* Normal video */
3043 gc_values.font = FRAME_FONT (f)->fid;
3044 gc_values.foreground = f->output_data.x->foreground_pixel;
3045 gc_values.background = f->output_data.x->background_pixel;
3046 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3047 f->output_data.x->normal_gc
3048 = XCreateGC (FRAME_X_DISPLAY (f),
3049 FRAME_X_WINDOW (f),
3050 GCLineWidth | GCFont | GCForeground | GCBackground,
3051 &gc_values);
3053 /* Reverse video style. */
3054 gc_values.foreground = f->output_data.x->background_pixel;
3055 gc_values.background = f->output_data.x->foreground_pixel;
3056 f->output_data.x->reverse_gc
3057 = XCreateGC (FRAME_X_DISPLAY (f),
3058 FRAME_X_WINDOW (f),
3059 GCFont | GCForeground | GCBackground | GCLineWidth,
3060 &gc_values);
3062 /* Cursor has cursor-color background, background-color foreground. */
3063 gc_values.foreground = f->output_data.x->background_pixel;
3064 gc_values.background = f->output_data.x->cursor_pixel;
3065 gc_values.fill_style = FillOpaqueStippled;
3066 gc_values.stipple
3067 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3068 FRAME_X_DISPLAY_INFO (f)->root_window,
3069 cursor_bits, 16, 16);
3070 f->output_data.x->cursor_gc
3071 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3072 (GCFont | GCForeground | GCBackground
3073 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3074 &gc_values);
3076 /* Reliefs. */
3077 f->output_data.x->white_relief.gc = 0;
3078 f->output_data.x->black_relief.gc = 0;
3080 /* Create the gray border tile used when the pointer is not in
3081 the frame. Since this depends on the frame's pixel values,
3082 this must be done on a per-frame basis. */
3083 f->output_data.x->border_tile
3084 = (XCreatePixmapFromBitmapData
3085 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3086 gray_bits, gray_width, gray_height,
3087 f->output_data.x->foreground_pixel,
3088 f->output_data.x->background_pixel,
3089 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
3091 UNBLOCK_INPUT;
3095 /* Free what was was allocated in x_make_gc. */
3097 void
3098 x_free_gcs (f)
3099 struct frame *f;
3101 Display *dpy = FRAME_X_DISPLAY (f);
3103 BLOCK_INPUT;
3105 if (f->output_data.x->normal_gc)
3107 XFreeGC (dpy, f->output_data.x->normal_gc);
3108 f->output_data.x->normal_gc = 0;
3111 if (f->output_data.x->reverse_gc)
3113 XFreeGC (dpy, f->output_data.x->reverse_gc);
3114 f->output_data.x->reverse_gc = 0;
3117 if (f->output_data.x->cursor_gc)
3119 XFreeGC (dpy, f->output_data.x->cursor_gc);
3120 f->output_data.x->cursor_gc = 0;
3123 if (f->output_data.x->border_tile)
3125 XFreePixmap (dpy, f->output_data.x->border_tile);
3126 f->output_data.x->border_tile = 0;
3129 UNBLOCK_INPUT;
3133 /* Handler for signals raised during x_create_frame and
3134 x_create_top_frame. FRAME is the frame which is partially
3135 constructed. */
3137 static Lisp_Object
3138 unwind_create_frame (frame)
3139 Lisp_Object frame;
3141 struct frame *f = XFRAME (frame);
3143 /* If frame is ``official'', nothing to do. */
3144 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
3146 #if GLYPH_DEBUG
3147 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3148 #endif
3150 x_free_frame_resources (f);
3152 /* Check that reference counts are indeed correct. */
3153 xassert (dpyinfo->reference_count == dpyinfo_refcount);
3154 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
3155 return Qt;
3158 return Qnil;
3162 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3163 1, 1, 0,
3164 doc: /* Make a new X window, which is called a "frame" in Emacs terms.
3165 Returns an Emacs frame object.
3166 ALIST is an alist of frame parameters.
3167 If the parameters specify that the frame should not have a minibuffer,
3168 and do not specify a specific minibuffer window to use,
3169 then `default-minibuffer-frame' must be a frame whose minibuffer can
3170 be shared by the new frame.
3172 This function is an internal primitive--use `make-frame' instead. */)
3173 (parms)
3174 Lisp_Object parms;
3176 struct frame *f;
3177 Lisp_Object frame, tem;
3178 Lisp_Object name;
3179 int minibuffer_only = 0;
3180 long window_prompting = 0;
3181 int width, height;
3182 int count = SPECPDL_INDEX ();
3183 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3184 Lisp_Object display;
3185 struct x_display_info *dpyinfo = NULL;
3186 Lisp_Object parent;
3187 struct kboard *kb;
3189 check_x ();
3191 /* Use this general default value to start with
3192 until we know if this frame has a specified name. */
3193 Vx_resource_name = Vinvocation_name;
3195 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3196 if (EQ (display, Qunbound))
3197 display = Qnil;
3198 dpyinfo = check_x_display_info (display);
3199 #ifdef MULTI_KBOARD
3200 kb = dpyinfo->kboard;
3201 #else
3202 kb = &the_only_kboard;
3203 #endif
3205 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3206 if (!STRINGP (name)
3207 && ! EQ (name, Qunbound)
3208 && ! NILP (name))
3209 error ("Invalid frame name--not a string or nil");
3211 if (STRINGP (name))
3212 Vx_resource_name = name;
3214 /* See if parent window is specified. */
3215 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3216 if (EQ (parent, Qunbound))
3217 parent = Qnil;
3218 if (! NILP (parent))
3219 CHECK_NUMBER (parent);
3221 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3222 /* No need to protect DISPLAY because that's not used after passing
3223 it to make_frame_without_minibuffer. */
3224 frame = Qnil;
3225 GCPRO4 (parms, parent, name, frame);
3226 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3227 RES_TYPE_SYMBOL);
3228 if (EQ (tem, Qnone) || NILP (tem))
3229 f = make_frame_without_minibuffer (Qnil, kb, display);
3230 else if (EQ (tem, Qonly))
3232 f = make_minibuffer_frame ();
3233 minibuffer_only = 1;
3235 else if (WINDOWP (tem))
3236 f = make_frame_without_minibuffer (tem, kb, display);
3237 else
3238 f = make_frame (1);
3240 XSETFRAME (frame, f);
3242 /* Note that X Windows does support scroll bars. */
3243 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3245 f->output_method = output_x_window;
3246 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3247 bzero (f->output_data.x, sizeof (struct x_output));
3248 f->output_data.x->icon_bitmap = -1;
3249 FRAME_FONTSET (f) = -1;
3250 f->output_data.x->scroll_bar_foreground_pixel = -1;
3251 f->output_data.x->scroll_bar_background_pixel = -1;
3252 #ifdef USE_TOOLKIT_SCROLL_BARS
3253 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
3254 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
3255 #endif /* USE_TOOLKIT_SCROLL_BARS */
3256 record_unwind_protect (unwind_create_frame, frame);
3258 f->icon_name
3259 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3260 RES_TYPE_STRING);
3261 if (! STRINGP (f->icon_name))
3262 f->icon_name = Qnil;
3264 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3265 #if GLYPH_DEBUG
3266 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
3267 dpyinfo_refcount = dpyinfo->reference_count;
3268 #endif /* GLYPH_DEBUG */
3269 #ifdef MULTI_KBOARD
3270 FRAME_KBOARD (f) = kb;
3271 #endif
3273 /* These colors will be set anyway later, but it's important
3274 to get the color reference counts right, so initialize them! */
3276 Lisp_Object black;
3277 struct gcpro gcpro1;
3279 /* Function x_decode_color can signal an error. Make
3280 sure to initialize color slots so that we won't try
3281 to free colors we haven't allocated. */
3282 f->output_data.x->foreground_pixel = -1;
3283 f->output_data.x->background_pixel = -1;
3284 f->output_data.x->cursor_pixel = -1;
3285 f->output_data.x->cursor_foreground_pixel = -1;
3286 f->output_data.x->border_pixel = -1;
3287 f->output_data.x->mouse_pixel = -1;
3289 black = build_string ("black");
3290 GCPRO1 (black);
3291 f->output_data.x->foreground_pixel
3292 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3293 f->output_data.x->background_pixel
3294 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3295 f->output_data.x->cursor_pixel
3296 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3297 f->output_data.x->cursor_foreground_pixel
3298 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3299 f->output_data.x->border_pixel
3300 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3301 f->output_data.x->mouse_pixel
3302 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
3303 UNGCPRO;
3306 /* Specify the parent under which to make this X window. */
3308 if (!NILP (parent))
3310 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3311 f->output_data.x->explicit_parent = 1;
3313 else
3315 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3316 f->output_data.x->explicit_parent = 0;
3319 /* Set the name; the functions to which we pass f expect the name to
3320 be set. */
3321 if (EQ (name, Qunbound) || NILP (name))
3323 f->name = build_string (dpyinfo->x_id_name);
3324 f->explicit_name = 0;
3326 else
3328 f->name = name;
3329 f->explicit_name = 1;
3330 /* use the frame's title when getting resources for this frame. */
3331 specbind (Qx_resource_name, name);
3334 /* Extract the window parameters from the supplied values
3335 that are needed to determine window geometry. */
3337 Lisp_Object font;
3339 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3341 BLOCK_INPUT;
3342 /* First, try whatever font the caller has specified. */
3343 if (STRINGP (font))
3345 tem = Fquery_fontset (font, Qnil);
3346 if (STRINGP (tem))
3347 font = x_new_fontset (f, SDATA (tem));
3348 else
3349 font = x_new_font (f, SDATA (font));
3352 /* Try out a font which we hope has bold and italic variations. */
3353 if (!STRINGP (font))
3354 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3355 if (!STRINGP (font))
3356 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3357 if (! STRINGP (font))
3358 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3359 if (! STRINGP (font))
3360 /* This was formerly the first thing tried, but it finds too many fonts
3361 and takes too long. */
3362 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3363 /* If those didn't work, look for something which will at least work. */
3364 if (! STRINGP (font))
3365 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3366 UNBLOCK_INPUT;
3367 if (! STRINGP (font))
3368 font = build_string ("fixed");
3370 x_default_parameter (f, parms, Qfont, font,
3371 "font", "Font", RES_TYPE_STRING);
3374 #ifdef USE_LUCID
3375 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3376 whereby it fails to get any font. */
3377 xlwmenu_default_font = FRAME_FONT (f);
3378 #endif
3380 x_default_parameter (f, parms, Qborder_width, make_number (2),
3381 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3383 /* This defaults to 1 in order to match xterm. We recognize either
3384 internalBorderWidth or internalBorder (which is what xterm calls
3385 it). */
3386 if (NILP (Fassq (Qinternal_border_width, parms)))
3388 Lisp_Object value;
3390 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3391 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3392 if (! EQ (value, Qunbound))
3393 parms = Fcons (Fcons (Qinternal_border_width, value),
3394 parms);
3396 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3397 "internalBorderWidth", "internalBorderWidth",
3398 RES_TYPE_NUMBER);
3399 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3400 "verticalScrollBars", "ScrollBars",
3401 RES_TYPE_SYMBOL);
3403 /* Also do the stuff which must be set before the window exists. */
3404 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3405 "foreground", "Foreground", RES_TYPE_STRING);
3406 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3407 "background", "Background", RES_TYPE_STRING);
3408 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3409 "pointerColor", "Foreground", RES_TYPE_STRING);
3410 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3411 "cursorColor", "Foreground", RES_TYPE_STRING);
3412 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3413 "borderColor", "BorderColor", RES_TYPE_STRING);
3414 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
3415 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
3416 x_default_parameter (f, parms, Qline_spacing, Qnil,
3417 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
3418 x_default_parameter (f, parms, Qleft_fringe, Qnil,
3419 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
3420 x_default_parameter (f, parms, Qright_fringe, Qnil,
3421 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
3423 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3424 "scrollBarForeground",
3425 "ScrollBarForeground", 1);
3426 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3427 "scrollBarBackground",
3428 "ScrollBarBackground", 0);
3430 /* Init faces before x_default_parameter is called for scroll-bar
3431 parameters because that function calls x_set_scroll_bar_width,
3432 which calls change_frame_size, which calls Fset_window_buffer,
3433 which runs hooks, which call Fvertical_motion. At the end, we
3434 end up in init_iterator with a null face cache, which should not
3435 happen. */
3436 init_frame_faces (f);
3438 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3439 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3440 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
3441 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3442 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3443 "bufferPredicate", "BufferPredicate",
3444 RES_TYPE_SYMBOL);
3445 x_default_parameter (f, parms, Qtitle, Qnil,
3446 "title", "Title", RES_TYPE_STRING);
3447 x_default_parameter (f, parms, Qwait_for_wm, Qt,
3448 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
3449 x_default_parameter (f, parms, Qfullscreen, Qnil,
3450 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
3452 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3454 /* Compute the size of the X window. */
3455 window_prompting = x_figure_window_size (f, parms, 1);
3457 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3458 f->no_split = minibuffer_only || EQ (tem, Qt);
3460 /* Create the X widget or window. */
3461 #ifdef USE_X_TOOLKIT
3462 x_window (f, window_prompting, minibuffer_only);
3463 #else
3464 x_window (f);
3465 #endif
3467 x_icon (f, parms);
3468 x_make_gc (f);
3470 /* Now consider the frame official. */
3471 FRAME_X_DISPLAY_INFO (f)->reference_count++;
3472 Vframe_list = Fcons (frame, Vframe_list);
3474 /* We need to do this after creating the X window, so that the
3475 icon-creation functions can say whose icon they're describing. */
3476 x_default_parameter (f, parms, Qicon_type, Qnil,
3477 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3479 x_default_parameter (f, parms, Qauto_raise, Qnil,
3480 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3481 x_default_parameter (f, parms, Qauto_lower, Qnil,
3482 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3483 x_default_parameter (f, parms, Qcursor_type, Qbox,
3484 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3485 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3486 "scrollBarWidth", "ScrollBarWidth",
3487 RES_TYPE_NUMBER);
3489 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
3490 Change will not be effected unless different from the current
3491 FRAME_LINES (f). */
3492 width = FRAME_COLS (f);
3493 height = FRAME_LINES (f);
3495 SET_FRAME_COLS (f, 0);
3496 FRAME_LINES (f) = 0;
3497 change_frame_size (f, height, width, 1, 0, 0);
3499 #if defined (USE_X_TOOLKIT) || defined (USE_GTK)
3500 /* Create the menu bar. */
3501 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3503 /* If this signals an error, we haven't set size hints for the
3504 frame and we didn't make it visible. */
3505 initialize_frame_menubar (f);
3507 #ifndef USE_GTK
3508 /* This is a no-op, except under Motif where it arranges the
3509 main window for the widgets on it. */
3510 lw_set_main_areas (f->output_data.x->column_widget,
3511 f->output_data.x->menubar_widget,
3512 f->output_data.x->edit_widget);
3513 #endif /* not USE_GTK */
3515 #endif /* USE_X_TOOLKIT || USE_GTK */
3517 /* Tell the server what size and position, etc, we want, and how
3518 badly we want them. This should be done after we have the menu
3519 bar so that its size can be taken into account. */
3520 BLOCK_INPUT;
3521 x_wm_set_size_hint (f, window_prompting, 0);
3522 UNBLOCK_INPUT;
3524 /* Make the window appear on the frame and enable display, unless
3525 the caller says not to. However, with explicit parent, Emacs
3526 cannot control visibility, so don't try. */
3527 if (! f->output_data.x->explicit_parent)
3529 Lisp_Object visibility;
3531 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3532 RES_TYPE_SYMBOL);
3533 if (EQ (visibility, Qunbound))
3534 visibility = Qt;
3536 if (EQ (visibility, Qicon))
3537 x_iconify_frame (f);
3538 else if (! NILP (visibility))
3539 x_make_frame_visible (f);
3540 else
3541 /* Must have been Qnil. */
3545 /* Set the WM leader property. GTK does this itself, so this is not
3546 needed when using GTK. */
3547 if (dpyinfo->client_leader_window != 0)
3549 BLOCK_INPUT;
3550 XChangeProperty (FRAME_X_DISPLAY (f),
3551 FRAME_OUTER_WINDOW (f),
3552 dpyinfo->Xatom_wm_client_leader,
3553 XA_WINDOW, 32, PropModeReplace,
3554 (char *) &dpyinfo->client_leader_window, 1);
3555 UNBLOCK_INPUT;
3558 UNGCPRO;
3560 /* Make sure windows on this frame appear in calls to next-window
3561 and similar functions. */
3562 Vwindow_list = Qnil;
3564 return unbind_to (count, frame);
3568 /* FRAME is used only to get a handle on the X display. We don't pass the
3569 display info directly because we're called from frame.c, which doesn't
3570 know about that structure. */
3572 Lisp_Object
3573 x_get_focus_frame (frame)
3574 struct frame *frame;
3576 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
3577 Lisp_Object xfocus;
3578 if (! dpyinfo->x_focus_frame)
3579 return Qnil;
3581 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3582 return xfocus;
3586 /* In certain situations, when the window manager follows a
3587 click-to-focus policy, there seems to be no way around calling
3588 XSetInputFocus to give another frame the input focus .
3590 In an ideal world, XSetInputFocus should generally be avoided so
3591 that applications don't interfere with the window manager's focus
3592 policy. But I think it's okay to use when it's clearly done
3593 following a user-command. */
3595 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
3596 doc: /* Set the input focus to FRAME.
3597 FRAME nil means use the selected frame. */)
3598 (frame)
3599 Lisp_Object frame;
3601 struct frame *f = check_x_frame (frame);
3602 Display *dpy = FRAME_X_DISPLAY (f);
3603 int count;
3605 BLOCK_INPUT;
3606 count = x_catch_errors (dpy);
3607 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3608 RevertToParent, CurrentTime);
3609 x_uncatch_errors (dpy, count);
3610 UNBLOCK_INPUT;
3612 return Qnil;
3616 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
3617 doc: /* Internal function called by `color-defined-p', which see. */)
3618 (color, frame)
3619 Lisp_Object color, frame;
3621 XColor foo;
3622 FRAME_PTR f = check_x_frame (frame);
3624 CHECK_STRING (color);
3626 if (x_defined_color (f, SDATA (color), &foo, 0))
3627 return Qt;
3628 else
3629 return Qnil;
3632 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
3633 doc: /* Internal function called by `color-values', which see. */)
3634 (color, frame)
3635 Lisp_Object color, frame;
3637 XColor foo;
3638 FRAME_PTR f = check_x_frame (frame);
3640 CHECK_STRING (color);
3642 if (x_defined_color (f, SDATA (color), &foo, 0))
3644 Lisp_Object rgb[3];
3646 rgb[0] = make_number (foo.red);
3647 rgb[1] = make_number (foo.green);
3648 rgb[2] = make_number (foo.blue);
3649 return Flist (3, rgb);
3651 else
3652 return Qnil;
3655 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
3656 doc: /* Internal function called by `display-color-p', which see. */)
3657 (display)
3658 Lisp_Object display;
3660 struct x_display_info *dpyinfo = check_x_display_info (display);
3662 if (dpyinfo->n_planes <= 2)
3663 return Qnil;
3665 switch (dpyinfo->visual->class)
3667 case StaticColor:
3668 case PseudoColor:
3669 case TrueColor:
3670 case DirectColor:
3671 return Qt;
3673 default:
3674 return Qnil;
3678 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
3679 0, 1, 0,
3680 doc: /* Return t if the X display supports shades of gray.
3681 Note that color displays do support shades of gray.
3682 The optional argument DISPLAY specifies which display to ask about.
3683 DISPLAY should be either a frame or a display name (a string).
3684 If omitted or nil, that stands for the selected frame's display. */)
3685 (display)
3686 Lisp_Object display;
3688 struct x_display_info *dpyinfo = check_x_display_info (display);
3690 if (dpyinfo->n_planes <= 1)
3691 return Qnil;
3693 switch (dpyinfo->visual->class)
3695 case StaticColor:
3696 case PseudoColor:
3697 case TrueColor:
3698 case DirectColor:
3699 case StaticGray:
3700 case GrayScale:
3701 return Qt;
3703 default:
3704 return Qnil;
3708 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
3709 0, 1, 0,
3710 doc: /* Returns the width in pixels of the X display DISPLAY.
3711 The optional argument DISPLAY specifies which display to ask about.
3712 DISPLAY should be either a frame or a display name (a string).
3713 If omitted or nil, that stands for the selected frame's display. */)
3714 (display)
3715 Lisp_Object display;
3717 struct x_display_info *dpyinfo = check_x_display_info (display);
3719 return make_number (dpyinfo->width);
3722 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
3723 Sx_display_pixel_height, 0, 1, 0,
3724 doc: /* Returns the height in pixels of the X display DISPLAY.
3725 The optional argument DISPLAY specifies which display to ask about.
3726 DISPLAY should be either a frame or a display name (a string).
3727 If omitted or nil, that stands for the selected frame's display. */)
3728 (display)
3729 Lisp_Object display;
3731 struct x_display_info *dpyinfo = check_x_display_info (display);
3733 return make_number (dpyinfo->height);
3736 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3737 0, 1, 0,
3738 doc: /* Returns the number of bitplanes of the X display DISPLAY.
3739 The optional argument DISPLAY specifies which display to ask about.
3740 DISPLAY should be either a frame or a display name (a string).
3741 If omitted or nil, that stands for the selected frame's display. */)
3742 (display)
3743 Lisp_Object display;
3745 struct x_display_info *dpyinfo = check_x_display_info (display);
3747 return make_number (dpyinfo->n_planes);
3750 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
3751 0, 1, 0,
3752 doc: /* Returns the number of color cells of the X display DISPLAY.
3753 The optional argument DISPLAY specifies which display to ask about.
3754 DISPLAY should be either a frame or a display name (a string).
3755 If omitted or nil, that stands for the selected frame's display. */)
3756 (display)
3757 Lisp_Object display;
3759 struct x_display_info *dpyinfo = check_x_display_info (display);
3761 return make_number (DisplayCells (dpyinfo->display,
3762 XScreenNumberOfScreen (dpyinfo->screen)));
3765 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
3766 Sx_server_max_request_size,
3767 0, 1, 0,
3768 doc: /* Returns the maximum request size of the X server of display DISPLAY.
3769 The optional argument DISPLAY specifies which display to ask about.
3770 DISPLAY should be either a frame or a display name (a string).
3771 If omitted or nil, that stands for the selected frame's display. */)
3772 (display)
3773 Lisp_Object display;
3775 struct x_display_info *dpyinfo = check_x_display_info (display);
3777 return make_number (MAXREQUEST (dpyinfo->display));
3780 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3781 doc: /* Returns the vendor ID string of the X server of display DISPLAY.
3782 The optional argument DISPLAY specifies which display to ask about.
3783 DISPLAY should be either a frame or a display name (a string).
3784 If omitted or nil, that stands for the selected frame's display. */)
3785 (display)
3786 Lisp_Object display;
3788 struct x_display_info *dpyinfo = check_x_display_info (display);
3789 char *vendor = ServerVendor (dpyinfo->display);
3791 if (! vendor) vendor = "";
3792 return build_string (vendor);
3795 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3796 doc: /* Returns the version numbers of the X server of display DISPLAY.
3797 The value is a list of three integers: the major and minor
3798 version numbers of the X Protocol in use, and the vendor-specific release
3799 number. See also the function `x-server-vendor'.
3801 The optional argument DISPLAY specifies which display to ask about.
3802 DISPLAY should be either a frame or a display name (a string).
3803 If omitted or nil, that stands for the selected frame's display. */)
3804 (display)
3805 Lisp_Object display;
3807 struct x_display_info *dpyinfo = check_x_display_info (display);
3808 Display *dpy = dpyinfo->display;
3810 return Fcons (make_number (ProtocolVersion (dpy)),
3811 Fcons (make_number (ProtocolRevision (dpy)),
3812 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3815 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3816 doc: /* Return the number of screens on the X server of display DISPLAY.
3817 The optional argument DISPLAY specifies which display to ask about.
3818 DISPLAY should be either a frame or a display name (a string).
3819 If omitted or nil, that stands for the selected frame's display. */)
3820 (display)
3821 Lisp_Object display;
3823 struct x_display_info *dpyinfo = check_x_display_info (display);
3825 return make_number (ScreenCount (dpyinfo->display));
3828 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3829 doc: /* Return the height in millimeters of the X display DISPLAY.
3830 The optional argument DISPLAY specifies which display to ask about.
3831 DISPLAY should be either a frame or a display name (a string).
3832 If omitted or nil, that stands for the selected frame's display. */)
3833 (display)
3834 Lisp_Object display;
3836 struct x_display_info *dpyinfo = check_x_display_info (display);
3838 return make_number (HeightMMOfScreen (dpyinfo->screen));
3841 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3842 doc: /* Return the width in millimeters of the X display DISPLAY.
3843 The optional argument DISPLAY specifies which display to ask about.
3844 DISPLAY should be either a frame or a display name (a string).
3845 If omitted or nil, that stands for the selected frame's display. */)
3846 (display)
3847 Lisp_Object display;
3849 struct x_display_info *dpyinfo = check_x_display_info (display);
3851 return make_number (WidthMMOfScreen (dpyinfo->screen));
3854 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3855 Sx_display_backing_store, 0, 1, 0,
3856 doc: /* Returns an indication of whether X display DISPLAY does backing store.
3857 The value may be `always', `when-mapped', or `not-useful'.
3858 The optional argument DISPLAY specifies which display to ask about.
3859 DISPLAY should be either a frame or a display name (a string).
3860 If omitted or nil, that stands for the selected frame's display. */)
3861 (display)
3862 Lisp_Object display;
3864 struct x_display_info *dpyinfo = check_x_display_info (display);
3865 Lisp_Object result;
3867 switch (DoesBackingStore (dpyinfo->screen))
3869 case Always:
3870 result = intern ("always");
3871 break;
3873 case WhenMapped:
3874 result = intern ("when-mapped");
3875 break;
3877 case NotUseful:
3878 result = intern ("not-useful");
3879 break;
3881 default:
3882 error ("Strange value for BackingStore parameter of screen");
3883 result = Qnil;
3886 return result;
3889 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3890 Sx_display_visual_class, 0, 1, 0,
3891 doc: /* Return the visual class of the X display DISPLAY.
3892 The value is one of the symbols `static-gray', `gray-scale',
3893 `static-color', `pseudo-color', `true-color', or `direct-color'.
3895 The optional argument DISPLAY specifies which display to ask about.
3896 DISPLAY should be either a frame or a display name (a string).
3897 If omitted or nil, that stands for the selected frame's display. */)
3898 (display)
3899 Lisp_Object display;
3901 struct x_display_info *dpyinfo = check_x_display_info (display);
3902 Lisp_Object result;
3904 switch (dpyinfo->visual->class)
3906 case StaticGray:
3907 result = intern ("static-gray");
3908 break;
3909 case GrayScale:
3910 result = intern ("gray-scale");
3911 break;
3912 case StaticColor:
3913 result = intern ("static-color");
3914 break;
3915 case PseudoColor:
3916 result = intern ("pseudo-color");
3917 break;
3918 case TrueColor:
3919 result = intern ("true-color");
3920 break;
3921 case DirectColor:
3922 result = intern ("direct-color");
3923 break;
3924 default:
3925 error ("Display has an unknown visual class");
3926 result = Qnil;
3929 return result;
3932 DEFUN ("x-display-save-under", Fx_display_save_under,
3933 Sx_display_save_under, 0, 1, 0,
3934 doc: /* Returns t if the X display DISPLAY supports the save-under feature.
3935 The optional argument DISPLAY specifies which display to ask about.
3936 DISPLAY should be either a frame or a display name (a string).
3937 If omitted or nil, that stands for the selected frame's display. */)
3938 (display)
3939 Lisp_Object display;
3941 struct x_display_info *dpyinfo = check_x_display_info (display);
3943 if (DoesSaveUnders (dpyinfo->screen) == True)
3944 return Qt;
3945 else
3946 return Qnil;
3950 x_pixel_width (f)
3951 register struct frame *f;
3953 return FRAME_PIXEL_WIDTH (f);
3957 x_pixel_height (f)
3958 register struct frame *f;
3960 return FRAME_PIXEL_HEIGHT (f);
3964 x_char_width (f)
3965 register struct frame *f;
3967 return FRAME_COLUMN_WIDTH (f);
3971 x_char_height (f)
3972 register struct frame *f;
3974 return FRAME_LINE_HEIGHT (f);
3978 x_screen_planes (f)
3979 register struct frame *f;
3981 return FRAME_X_DISPLAY_INFO (f)->n_planes;
3986 /************************************************************************
3987 X Displays
3988 ************************************************************************/
3991 /* Mapping visual names to visuals. */
3993 static struct visual_class
3995 char *name;
3996 int class;
3998 visual_classes[] =
4000 {"StaticGray", StaticGray},
4001 {"GrayScale", GrayScale},
4002 {"StaticColor", StaticColor},
4003 {"PseudoColor", PseudoColor},
4004 {"TrueColor", TrueColor},
4005 {"DirectColor", DirectColor},
4006 {NULL, 0}
4010 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4012 /* Value is the screen number of screen SCR. This is a substitute for
4013 the X function with the same name when that doesn't exist. */
4016 XScreenNumberOfScreen (scr)
4017 register Screen *scr;
4019 Display *dpy = scr->display;
4020 int i;
4022 for (i = 0; i < dpy->nscreens; ++i)
4023 if (scr == dpy->screens + i)
4024 break;
4026 return i;
4029 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4032 /* Select the visual that should be used on display DPYINFO. Set
4033 members of DPYINFO appropriately. Called from x_term_init. */
4035 void
4036 select_visual (dpyinfo)
4037 struct x_display_info *dpyinfo;
4039 Display *dpy = dpyinfo->display;
4040 Screen *screen = dpyinfo->screen;
4041 Lisp_Object value;
4043 /* See if a visual is specified. */
4044 value = display_x_get_resource (dpyinfo,
4045 build_string ("visualClass"),
4046 build_string ("VisualClass"),
4047 Qnil, Qnil);
4048 if (STRINGP (value))
4050 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4051 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4052 depth, a decimal number. NAME is compared with case ignored. */
4053 char *s = (char *) alloca (SBYTES (value) + 1);
4054 char *dash;
4055 int i, class = -1;
4056 XVisualInfo vinfo;
4058 strcpy (s, SDATA (value));
4059 dash = index (s, '-');
4060 if (dash)
4062 dpyinfo->n_planes = atoi (dash + 1);
4063 *dash = '\0';
4065 else
4066 /* We won't find a matching visual with depth 0, so that
4067 an error will be printed below. */
4068 dpyinfo->n_planes = 0;
4070 /* Determine the visual class. */
4071 for (i = 0; visual_classes[i].name; ++i)
4072 if (xstricmp (s, visual_classes[i].name) == 0)
4074 class = visual_classes[i].class;
4075 break;
4078 /* Look up a matching visual for the specified class. */
4079 if (class == -1
4080 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
4081 dpyinfo->n_planes, class, &vinfo))
4082 fatal ("Invalid visual specification `%s'", SDATA (value));
4084 dpyinfo->visual = vinfo.visual;
4086 else
4088 int n_visuals;
4089 XVisualInfo *vinfo, vinfo_template;
4091 dpyinfo->visual = DefaultVisualOfScreen (screen);
4093 #ifdef HAVE_X11R4
4094 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
4095 #else
4096 vinfo_template.visualid = dpyinfo->visual->visualid;
4097 #endif
4098 vinfo_template.screen = XScreenNumberOfScreen (screen);
4099 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
4100 &vinfo_template, &n_visuals);
4101 if (n_visuals != 1)
4102 fatal ("Can't get proper X visual info");
4104 dpyinfo->n_planes = vinfo->depth;
4105 XFree ((char *) vinfo);
4110 /* Return the X display structure for the display named NAME.
4111 Open a new connection if necessary. */
4113 struct x_display_info *
4114 x_display_info_for_name (name)
4115 Lisp_Object name;
4117 Lisp_Object names;
4118 struct x_display_info *dpyinfo;
4120 CHECK_STRING (name);
4122 if (! EQ (Vwindow_system, intern ("x")))
4123 error ("Not using X Windows");
4125 for (dpyinfo = x_display_list, names = x_display_name_list;
4126 dpyinfo;
4127 dpyinfo = dpyinfo->next, names = XCDR (names))
4129 Lisp_Object tem;
4130 tem = Fstring_equal (XCAR (XCAR (names)), name);
4131 if (!NILP (tem))
4132 return dpyinfo;
4135 /* Use this general default value to start with. */
4136 Vx_resource_name = Vinvocation_name;
4138 validate_x_resource_name ();
4140 dpyinfo = x_term_init (name, (char *)0,
4141 (char *) SDATA (Vx_resource_name));
4143 if (dpyinfo == 0)
4144 error ("Cannot connect to X server %s", SDATA (name));
4146 x_in_use = 1;
4147 XSETFASTINT (Vwindow_system_version, 11);
4149 return dpyinfo;
4153 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4154 1, 3, 0,
4155 doc: /* Open a connection to an X server.
4156 DISPLAY is the name of the display to connect to.
4157 Optional second arg XRM-STRING is a string of resources in xrdb format.
4158 If the optional third arg MUST-SUCCEED is non-nil,
4159 terminate Emacs if we can't open the connection. */)
4160 (display, xrm_string, must_succeed)
4161 Lisp_Object display, xrm_string, must_succeed;
4163 unsigned char *xrm_option;
4164 struct x_display_info *dpyinfo;
4166 CHECK_STRING (display);
4167 if (! NILP (xrm_string))
4168 CHECK_STRING (xrm_string);
4170 if (! EQ (Vwindow_system, intern ("x")))
4171 error ("Not using X Windows");
4173 if (! NILP (xrm_string))
4174 xrm_option = (unsigned char *) SDATA (xrm_string);
4175 else
4176 xrm_option = (unsigned char *) 0;
4178 validate_x_resource_name ();
4180 /* This is what opens the connection and sets x_current_display.
4181 This also initializes many symbols, such as those used for input. */
4182 dpyinfo = x_term_init (display, xrm_option,
4183 (char *) SDATA (Vx_resource_name));
4185 if (dpyinfo == 0)
4187 if (!NILP (must_succeed))
4188 fatal ("Cannot connect to X server %s.\n\
4189 Check the DISPLAY environment variable or use `-d'.\n\
4190 Also use the `xauth' program to verify that you have the proper\n\
4191 authorization information needed to connect the X server.\n\
4192 An insecure way to solve the problem may be to use `xhost'.\n",
4193 SDATA (display));
4194 else
4195 error ("Cannot connect to X server %s", SDATA (display));
4198 x_in_use = 1;
4200 XSETFASTINT (Vwindow_system_version, 11);
4201 return Qnil;
4204 DEFUN ("x-close-connection", Fx_close_connection,
4205 Sx_close_connection, 1, 1, 0,
4206 doc: /* Close the connection to DISPLAY's X server.
4207 For DISPLAY, specify either a frame or a display name (a string).
4208 If DISPLAY is nil, that stands for the selected frame's display. */)
4209 (display)
4210 Lisp_Object display;
4212 struct x_display_info *dpyinfo = check_x_display_info (display);
4213 int i;
4215 if (dpyinfo->reference_count > 0)
4216 error ("Display still has frames on it");
4218 BLOCK_INPUT;
4219 /* Free the fonts in the font table. */
4220 for (i = 0; i < dpyinfo->n_fonts; i++)
4221 if (dpyinfo->font_table[i].name)
4223 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
4226 x_destroy_all_bitmaps (dpyinfo);
4227 XSetCloseDownMode (dpyinfo->display, DestroyAll);
4229 #ifdef USE_X_TOOLKIT
4230 XtCloseDisplay (dpyinfo->display);
4231 #else
4232 XCloseDisplay (dpyinfo->display);
4233 #endif
4235 x_delete_display (dpyinfo);
4236 UNBLOCK_INPUT;
4238 return Qnil;
4241 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4242 doc: /* Return the list of display names that Emacs has connections to. */)
4245 Lisp_Object tail, result;
4247 result = Qnil;
4248 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
4249 result = Fcons (XCAR (XCAR (tail)), result);
4251 return result;
4254 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4255 doc: /* If ON is non-nil, report X errors as soon as the erring request is made.
4256 If ON is nil, allow buffering of requests.
4257 Turning on synchronization prohibits the Xlib routines from buffering
4258 requests and seriously degrades performance, but makes debugging much
4259 easier.
4260 The optional second argument DISPLAY specifies which display to act on.
4261 DISPLAY should be either a frame or a display name (a string).
4262 If DISPLAY is omitted or nil, that stands for the selected frame's display. */)
4263 (on, display)
4264 Lisp_Object display, on;
4266 struct x_display_info *dpyinfo = check_x_display_info (display);
4268 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
4270 return Qnil;
4273 /* Wait for responses to all X commands issued so far for frame F. */
4275 void
4276 x_sync (f)
4277 FRAME_PTR f;
4279 BLOCK_INPUT;
4280 XSync (FRAME_X_DISPLAY (f), False);
4281 UNBLOCK_INPUT;
4285 /***********************************************************************
4286 Image types
4287 ***********************************************************************/
4289 /* Value is the number of elements of vector VECTOR. */
4291 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4293 /* List of supported image types. Use define_image_type to add new
4294 types. Use lookup_image_type to find a type for a given symbol. */
4296 static struct image_type *image_types;
4298 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4300 Lisp_Object Qxbm;
4302 /* Keywords. */
4304 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
4305 extern Lisp_Object QCdata, QCtype;
4306 Lisp_Object QCascent, QCmargin, QCrelief;
4307 Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4308 Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
4310 /* Other symbols. */
4312 Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
4314 /* Time in seconds after which images should be removed from the cache
4315 if not displayed. */
4317 Lisp_Object Vimage_cache_eviction_delay;
4319 /* Function prototypes. */
4321 static void define_image_type P_ ((struct image_type *type));
4322 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
4323 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
4324 static void x_laplace P_ ((struct frame *, struct image *));
4325 static void x_emboss P_ ((struct frame *, struct image *));
4326 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
4327 Lisp_Object));
4330 /* Define a new image type from TYPE. This adds a copy of TYPE to
4331 image_types and adds the symbol *TYPE->type to Vimage_types. */
4333 static void
4334 define_image_type (type)
4335 struct image_type *type;
4337 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4338 The initialized data segment is read-only. */
4339 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
4340 bcopy (type, p, sizeof *p);
4341 p->next = image_types;
4342 image_types = p;
4343 Vimage_types = Fcons (*p->type, Vimage_types);
4347 /* Look up image type SYMBOL, and return a pointer to its image_type
4348 structure. Value is null if SYMBOL is not a known image type. */
4350 static INLINE struct image_type *
4351 lookup_image_type (symbol)
4352 Lisp_Object symbol;
4354 struct image_type *type;
4356 for (type = image_types; type; type = type->next)
4357 if (EQ (symbol, *type->type))
4358 break;
4360 return type;
4364 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4365 valid image specification is a list whose car is the symbol
4366 `image', and whose rest is a property list. The property list must
4367 contain a value for key `:type'. That value must be the name of a
4368 supported image type. The rest of the property list depends on the
4369 image type. */
4372 valid_image_p (object)
4373 Lisp_Object object;
4375 int valid_p = 0;
4377 if (IMAGEP (object))
4379 Lisp_Object tem;
4381 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
4382 if (EQ (XCAR (tem), QCtype))
4384 tem = XCDR (tem);
4385 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
4387 struct image_type *type;
4388 type = lookup_image_type (XCAR (tem));
4389 if (type)
4390 valid_p = type->valid_p (object);
4393 break;
4397 return valid_p;
4401 /* Log error message with format string FORMAT and argument ARG.
4402 Signaling an error, e.g. when an image cannot be loaded, is not a
4403 good idea because this would interrupt redisplay, and the error
4404 message display would lead to another redisplay. This function
4405 therefore simply displays a message. */
4407 static void
4408 image_error (format, arg1, arg2)
4409 char *format;
4410 Lisp_Object arg1, arg2;
4412 add_to_log (format, arg1, arg2);
4417 /***********************************************************************
4418 Image specifications
4419 ***********************************************************************/
4421 enum image_value_type
4423 IMAGE_DONT_CHECK_VALUE_TYPE,
4424 IMAGE_STRING_VALUE,
4425 IMAGE_STRING_OR_NIL_VALUE,
4426 IMAGE_SYMBOL_VALUE,
4427 IMAGE_POSITIVE_INTEGER_VALUE,
4428 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
4429 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
4430 IMAGE_ASCENT_VALUE,
4431 IMAGE_INTEGER_VALUE,
4432 IMAGE_FUNCTION_VALUE,
4433 IMAGE_NUMBER_VALUE,
4434 IMAGE_BOOL_VALUE
4437 /* Structure used when parsing image specifications. */
4439 struct image_keyword
4441 /* Name of keyword. */
4442 char *name;
4444 /* The type of value allowed. */
4445 enum image_value_type type;
4447 /* Non-zero means key must be present. */
4448 int mandatory_p;
4450 /* Used to recognize duplicate keywords in a property list. */
4451 int count;
4453 /* The value that was found. */
4454 Lisp_Object value;
4458 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
4459 int, Lisp_Object));
4460 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
4463 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4464 has the format (image KEYWORD VALUE ...). One of the keyword/
4465 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4466 image_keywords structures of size NKEYWORDS describing other
4467 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4469 static int
4470 parse_image_spec (spec, keywords, nkeywords, type)
4471 Lisp_Object spec;
4472 struct image_keyword *keywords;
4473 int nkeywords;
4474 Lisp_Object type;
4476 int i;
4477 Lisp_Object plist;
4479 if (!IMAGEP (spec))
4480 return 0;
4482 plist = XCDR (spec);
4483 while (CONSP (plist))
4485 Lisp_Object key, value;
4487 /* First element of a pair must be a symbol. */
4488 key = XCAR (plist);
4489 plist = XCDR (plist);
4490 if (!SYMBOLP (key))
4491 return 0;
4493 /* There must follow a value. */
4494 if (!CONSP (plist))
4495 return 0;
4496 value = XCAR (plist);
4497 plist = XCDR (plist);
4499 /* Find key in KEYWORDS. Error if not found. */
4500 for (i = 0; i < nkeywords; ++i)
4501 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
4502 break;
4504 if (i == nkeywords)
4505 continue;
4507 /* Record that we recognized the keyword. If a keywords
4508 was found more than once, it's an error. */
4509 keywords[i].value = value;
4510 ++keywords[i].count;
4512 if (keywords[i].count > 1)
4513 return 0;
4515 /* Check type of value against allowed type. */
4516 switch (keywords[i].type)
4518 case IMAGE_STRING_VALUE:
4519 if (!STRINGP (value))
4520 return 0;
4521 break;
4523 case IMAGE_STRING_OR_NIL_VALUE:
4524 if (!STRINGP (value) && !NILP (value))
4525 return 0;
4526 break;
4528 case IMAGE_SYMBOL_VALUE:
4529 if (!SYMBOLP (value))
4530 return 0;
4531 break;
4533 case IMAGE_POSITIVE_INTEGER_VALUE:
4534 if (!INTEGERP (value) || XINT (value) <= 0)
4535 return 0;
4536 break;
4538 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
4539 if (INTEGERP (value) && XINT (value) >= 0)
4540 break;
4541 if (CONSP (value)
4542 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
4543 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
4544 break;
4545 return 0;
4547 case IMAGE_ASCENT_VALUE:
4548 if (SYMBOLP (value) && EQ (value, Qcenter))
4549 break;
4550 else if (INTEGERP (value)
4551 && XINT (value) >= 0
4552 && XINT (value) <= 100)
4553 break;
4554 return 0;
4556 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
4557 if (!INTEGERP (value) || XINT (value) < 0)
4558 return 0;
4559 break;
4561 case IMAGE_DONT_CHECK_VALUE_TYPE:
4562 break;
4564 case IMAGE_FUNCTION_VALUE:
4565 value = indirect_function (value);
4566 if (SUBRP (value)
4567 || COMPILEDP (value)
4568 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
4569 break;
4570 return 0;
4572 case IMAGE_NUMBER_VALUE:
4573 if (!INTEGERP (value) && !FLOATP (value))
4574 return 0;
4575 break;
4577 case IMAGE_INTEGER_VALUE:
4578 if (!INTEGERP (value))
4579 return 0;
4580 break;
4582 case IMAGE_BOOL_VALUE:
4583 if (!NILP (value) && !EQ (value, Qt))
4584 return 0;
4585 break;
4587 default:
4588 abort ();
4589 break;
4592 if (EQ (key, QCtype) && !EQ (type, value))
4593 return 0;
4596 /* Check that all mandatory fields are present. */
4597 for (i = 0; i < nkeywords; ++i)
4598 if (keywords[i].mandatory_p && keywords[i].count == 0)
4599 return 0;
4601 return NILP (plist);
4605 /* Return the value of KEY in image specification SPEC. Value is nil
4606 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
4607 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
4609 static Lisp_Object
4610 image_spec_value (spec, key, found)
4611 Lisp_Object spec, key;
4612 int *found;
4614 Lisp_Object tail;
4616 xassert (valid_image_p (spec));
4618 for (tail = XCDR (spec);
4619 CONSP (tail) && CONSP (XCDR (tail));
4620 tail = XCDR (XCDR (tail)))
4622 if (EQ (XCAR (tail), key))
4624 if (found)
4625 *found = 1;
4626 return XCAR (XCDR (tail));
4630 if (found)
4631 *found = 0;
4632 return Qnil;
4636 DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
4637 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
4638 PIXELS non-nil means return the size in pixels, otherwise return the
4639 size in canonical character units.
4640 FRAME is the frame on which the image will be displayed. FRAME nil
4641 or omitted means use the selected frame. */)
4642 (spec, pixels, frame)
4643 Lisp_Object spec, pixels, frame;
4645 Lisp_Object size;
4647 size = Qnil;
4648 if (valid_image_p (spec))
4650 struct frame *f = check_x_frame (frame);
4651 int id = lookup_image (f, spec);
4652 struct image *img = IMAGE_FROM_ID (f, id);
4653 int width = img->width + 2 * img->hmargin;
4654 int height = img->height + 2 * img->vmargin;
4656 if (NILP (pixels))
4657 size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
4658 make_float ((double) height / FRAME_LINE_HEIGHT (f)));
4659 else
4660 size = Fcons (make_number (width), make_number (height));
4662 else
4663 error ("Invalid image specification");
4665 return size;
4669 DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
4670 doc: /* Return t if image SPEC has a mask bitmap.
4671 FRAME is the frame on which the image will be displayed. FRAME nil
4672 or omitted means use the selected frame. */)
4673 (spec, frame)
4674 Lisp_Object spec, frame;
4676 Lisp_Object mask;
4678 mask = Qnil;
4679 if (valid_image_p (spec))
4681 struct frame *f = check_x_frame (frame);
4682 int id = lookup_image (f, spec);
4683 struct image *img = IMAGE_FROM_ID (f, id);
4684 if (img->mask)
4685 mask = Qt;
4687 else
4688 error ("Invalid image specification");
4690 return mask;
4695 /***********************************************************************
4696 Image type independent image structures
4697 ***********************************************************************/
4699 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
4700 static void free_image P_ ((struct frame *f, struct image *img));
4703 /* Allocate and return a new image structure for image specification
4704 SPEC. SPEC has a hash value of HASH. */
4706 static struct image *
4707 make_image (spec, hash)
4708 Lisp_Object spec;
4709 unsigned hash;
4711 struct image *img = (struct image *) xmalloc (sizeof *img);
4713 xassert (valid_image_p (spec));
4714 bzero (img, sizeof *img);
4715 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
4716 xassert (img->type != NULL);
4717 img->spec = spec;
4718 img->data.lisp_val = Qnil;
4719 img->ascent = DEFAULT_IMAGE_ASCENT;
4720 img->hash = hash;
4721 return img;
4725 /* Free image IMG which was used on frame F, including its resources. */
4727 static void
4728 free_image (f, img)
4729 struct frame *f;
4730 struct image *img;
4732 if (img)
4734 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
4736 /* Remove IMG from the hash table of its cache. */
4737 if (img->prev)
4738 img->prev->next = img->next;
4739 else
4740 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
4742 if (img->next)
4743 img->next->prev = img->prev;
4745 c->images[img->id] = NULL;
4747 /* Free resources, then free IMG. */
4748 img->type->free (f, img);
4749 xfree (img);
4754 /* Prepare image IMG for display on frame F. Must be called before
4755 drawing an image. */
4757 void
4758 prepare_image_for_display (f, img)
4759 struct frame *f;
4760 struct image *img;
4762 EMACS_TIME t;
4764 /* We're about to display IMG, so set its timestamp to `now'. */
4765 EMACS_GET_TIME (t);
4766 img->timestamp = EMACS_SECS (t);
4768 /* If IMG doesn't have a pixmap yet, load it now, using the image
4769 type dependent loader function. */
4770 if (img->pixmap == None && !img->load_failed_p)
4771 img->load_failed_p = img->type->load (f, img) == 0;
4775 /* Value is the number of pixels for the ascent of image IMG when
4776 drawn in face FACE. */
4779 image_ascent (img, face)
4780 struct image *img;
4781 struct face *face;
4783 int height = img->height + img->vmargin;
4784 int ascent;
4786 if (img->ascent == CENTERED_IMAGE_ASCENT)
4788 if (face->font)
4789 /* This expression is arranged so that if the image can't be
4790 exactly centered, it will be moved slightly up. This is
4791 because a typical font is `top-heavy' (due to the presence
4792 uppercase letters), so the image placement should err towards
4793 being top-heavy too. It also just generally looks better. */
4794 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
4795 else
4796 ascent = height / 2;
4798 else
4799 ascent = height * img->ascent / 100.0;
4801 return ascent;
4805 /* Image background colors. */
4807 static unsigned long
4808 four_corners_best (ximg, width, height)
4809 XImage *ximg;
4810 unsigned long width, height;
4812 unsigned long corners[4], best;
4813 int i, best_count;
4815 /* Get the colors at the corners of ximg. */
4816 corners[0] = XGetPixel (ximg, 0, 0);
4817 corners[1] = XGetPixel (ximg, width - 1, 0);
4818 corners[2] = XGetPixel (ximg, width - 1, height - 1);
4819 corners[3] = XGetPixel (ximg, 0, height - 1);
4821 /* Choose the most frequently found color as background. */
4822 for (i = best_count = 0; i < 4; ++i)
4824 int j, n;
4826 for (j = n = 0; j < 4; ++j)
4827 if (corners[i] == corners[j])
4828 ++n;
4830 if (n > best_count)
4831 best = corners[i], best_count = n;
4834 return best;
4837 /* Return the `background' field of IMG. If IMG doesn't have one yet,
4838 it is guessed heuristically. If non-zero, XIMG is an existing XImage
4839 object to use for the heuristic. */
4841 unsigned long
4842 image_background (img, f, ximg)
4843 struct image *img;
4844 struct frame *f;
4845 XImage *ximg;
4847 if (! img->background_valid)
4848 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4850 int free_ximg = !ximg;
4852 if (! ximg)
4853 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
4854 0, 0, img->width, img->height, ~0, ZPixmap);
4856 img->background = four_corners_best (ximg, img->width, img->height);
4858 if (free_ximg)
4859 XDestroyImage (ximg);
4861 img->background_valid = 1;
4864 return img->background;
4867 /* Return the `background_transparent' field of IMG. If IMG doesn't
4868 have one yet, it is guessed heuristically. If non-zero, MASK is an
4869 existing XImage object to use for the heuristic. */
4872 image_background_transparent (img, f, mask)
4873 struct image *img;
4874 struct frame *f;
4875 XImage *mask;
4877 if (! img->background_transparent_valid)
4878 /* IMG doesn't have a background yet, try to guess a reasonable value. */
4880 if (img->mask)
4882 int free_mask = !mask;
4884 if (! mask)
4885 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
4886 0, 0, img->width, img->height, ~0, ZPixmap);
4888 img->background_transparent
4889 = !four_corners_best (mask, img->width, img->height);
4891 if (free_mask)
4892 XDestroyImage (mask);
4894 else
4895 img->background_transparent = 0;
4897 img->background_transparent_valid = 1;
4900 return img->background_transparent;
4904 /***********************************************************************
4905 Helper functions for X image types
4906 ***********************************************************************/
4908 static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
4909 int, int));
4910 static void x_clear_image P_ ((struct frame *f, struct image *img));
4911 static unsigned long x_alloc_image_color P_ ((struct frame *f,
4912 struct image *img,
4913 Lisp_Object color_name,
4914 unsigned long dflt));
4917 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
4918 free the pixmap if any. MASK_P non-zero means clear the mask
4919 pixmap if any. COLORS_P non-zero means free colors allocated for
4920 the image, if any. */
4922 static void
4923 x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
4924 struct frame *f;
4925 struct image *img;
4926 int pixmap_p, mask_p, colors_p;
4928 if (pixmap_p && img->pixmap)
4930 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
4931 img->pixmap = None;
4932 img->background_valid = 0;
4935 if (mask_p && img->mask)
4937 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
4938 img->mask = None;
4939 img->background_transparent_valid = 0;
4942 if (colors_p && img->ncolors)
4944 x_free_colors (f, img->colors, img->ncolors);
4945 xfree (img->colors);
4946 img->colors = NULL;
4947 img->ncolors = 0;
4951 /* Free X resources of image IMG which is used on frame F. */
4953 static void
4954 x_clear_image (f, img)
4955 struct frame *f;
4956 struct image *img;
4958 BLOCK_INPUT;
4959 x_clear_image_1 (f, img, 1, 1, 1);
4960 UNBLOCK_INPUT;
4964 /* Allocate color COLOR_NAME for image IMG on frame F. If color
4965 cannot be allocated, use DFLT. Add a newly allocated color to
4966 IMG->colors, so that it can be freed again. Value is the pixel
4967 color. */
4969 static unsigned long
4970 x_alloc_image_color (f, img, color_name, dflt)
4971 struct frame *f;
4972 struct image *img;
4973 Lisp_Object color_name;
4974 unsigned long dflt;
4976 XColor color;
4977 unsigned long result;
4979 xassert (STRINGP (color_name));
4981 if (x_defined_color (f, SDATA (color_name), &color, 1))
4983 /* This isn't called frequently so we get away with simply
4984 reallocating the color vector to the needed size, here. */
4985 ++img->ncolors;
4986 img->colors =
4987 (unsigned long *) xrealloc (img->colors,
4988 img->ncolors * sizeof *img->colors);
4989 img->colors[img->ncolors - 1] = color.pixel;
4990 result = color.pixel;
4992 else
4993 result = dflt;
4995 return result;
5000 /***********************************************************************
5001 Image Cache
5002 ***********************************************************************/
5004 static void cache_image P_ ((struct frame *f, struct image *img));
5005 static void postprocess_image P_ ((struct frame *, struct image *));
5008 /* Return a new, initialized image cache that is allocated from the
5009 heap. Call free_image_cache to free an image cache. */
5011 struct image_cache *
5012 make_image_cache ()
5014 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5015 int size;
5017 bzero (c, sizeof *c);
5018 c->size = 50;
5019 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5020 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5021 c->buckets = (struct image **) xmalloc (size);
5022 bzero (c->buckets, size);
5023 return c;
5027 /* Free image cache of frame F. Be aware that X frames share images
5028 caches. */
5030 void
5031 free_image_cache (f)
5032 struct frame *f;
5034 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5035 if (c)
5037 int i;
5039 /* Cache should not be referenced by any frame when freed. */
5040 xassert (c->refcount == 0);
5042 for (i = 0; i < c->used; ++i)
5043 free_image (f, c->images[i]);
5044 xfree (c->images);
5045 xfree (c->buckets);
5046 xfree (c);
5047 FRAME_X_IMAGE_CACHE (f) = NULL;
5052 /* Clear image cache of frame F. FORCE_P non-zero means free all
5053 images. FORCE_P zero means clear only images that haven't been
5054 displayed for some time. Should be called from time to time to
5055 reduce the number of loaded images. If image-eviction-seconds is
5056 non-nil, this frees images in the cache which weren't displayed for
5057 at least that many seconds. */
5059 void
5060 clear_image_cache (f, force_p)
5061 struct frame *f;
5062 int force_p;
5064 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5066 if (c && INTEGERP (Vimage_cache_eviction_delay))
5068 EMACS_TIME t;
5069 unsigned long old;
5070 int i, nfreed;
5072 EMACS_GET_TIME (t);
5073 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
5075 /* Block input so that we won't be interrupted by a SIGIO
5076 while being in an inconsistent state. */
5077 BLOCK_INPUT;
5079 for (i = nfreed = 0; i < c->used; ++i)
5081 struct image *img = c->images[i];
5082 if (img != NULL
5083 && (force_p || img->timestamp < old))
5085 free_image (f, img);
5086 ++nfreed;
5090 /* We may be clearing the image cache because, for example,
5091 Emacs was iconified for a longer period of time. In that
5092 case, current matrices may still contain references to
5093 images freed above. So, clear these matrices. */
5094 if (nfreed)
5096 Lisp_Object tail, frame;
5098 FOR_EACH_FRAME (tail, frame)
5100 struct frame *f = XFRAME (frame);
5101 if (FRAME_X_P (f)
5102 && FRAME_X_IMAGE_CACHE (f) == c)
5103 clear_current_matrices (f);
5106 ++windows_or_buffers_changed;
5109 UNBLOCK_INPUT;
5114 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5115 0, 1, 0,
5116 doc: /* Clear the image cache of FRAME.
5117 FRAME nil or omitted means use the selected frame.
5118 FRAME t means clear the image caches of all frames. */)
5119 (frame)
5120 Lisp_Object frame;
5122 if (EQ (frame, Qt))
5124 Lisp_Object tail;
5126 FOR_EACH_FRAME (tail, frame)
5127 if (FRAME_X_P (XFRAME (frame)))
5128 clear_image_cache (XFRAME (frame), 1);
5130 else
5131 clear_image_cache (check_x_frame (frame), 1);
5133 return Qnil;
5137 /* Compute masks and transform image IMG on frame F, as specified
5138 by the image's specification, */
5140 static void
5141 postprocess_image (f, img)
5142 struct frame *f;
5143 struct image *img;
5145 /* Manipulation of the image's mask. */
5146 if (img->pixmap)
5148 Lisp_Object conversion, spec;
5149 Lisp_Object mask;
5151 spec = img->spec;
5153 /* `:heuristic-mask t'
5154 `:mask heuristic'
5155 means build a mask heuristically.
5156 `:heuristic-mask (R G B)'
5157 `:mask (heuristic (R G B))'
5158 means build a mask from color (R G B) in the
5159 image.
5160 `:mask nil'
5161 means remove a mask, if any. */
5163 mask = image_spec_value (spec, QCheuristic_mask, NULL);
5164 if (!NILP (mask))
5165 x_build_heuristic_mask (f, img, mask);
5166 else
5168 int found_p;
5170 mask = image_spec_value (spec, QCmask, &found_p);
5172 if (EQ (mask, Qheuristic))
5173 x_build_heuristic_mask (f, img, Qt);
5174 else if (CONSP (mask)
5175 && EQ (XCAR (mask), Qheuristic))
5177 if (CONSP (XCDR (mask)))
5178 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
5179 else
5180 x_build_heuristic_mask (f, img, XCDR (mask));
5182 else if (NILP (mask) && found_p && img->mask)
5184 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
5185 img->mask = None;
5190 /* Should we apply an image transformation algorithm? */
5191 conversion = image_spec_value (spec, QCconversion, NULL);
5192 if (EQ (conversion, Qdisabled))
5193 x_disable_image (f, img);
5194 else if (EQ (conversion, Qlaplace))
5195 x_laplace (f, img);
5196 else if (EQ (conversion, Qemboss))
5197 x_emboss (f, img);
5198 else if (CONSP (conversion)
5199 && EQ (XCAR (conversion), Qedge_detection))
5201 Lisp_Object tem;
5202 tem = XCDR (conversion);
5203 if (CONSP (tem))
5204 x_edge_detection (f, img,
5205 Fplist_get (tem, QCmatrix),
5206 Fplist_get (tem, QCcolor_adjustment));
5212 /* Return the id of image with Lisp specification SPEC on frame F.
5213 SPEC must be a valid Lisp image specification (see valid_image_p). */
5216 lookup_image (f, spec)
5217 struct frame *f;
5218 Lisp_Object spec;
5220 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5221 struct image *img;
5222 int i;
5223 unsigned hash;
5224 struct gcpro gcpro1;
5225 EMACS_TIME now;
5227 /* F must be a window-system frame, and SPEC must be a valid image
5228 specification. */
5229 xassert (FRAME_WINDOW_P (f));
5230 xassert (valid_image_p (spec));
5232 GCPRO1 (spec);
5234 /* Look up SPEC in the hash table of the image cache. */
5235 hash = sxhash (spec, 0);
5236 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5238 for (img = c->buckets[i]; img; img = img->next)
5239 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
5240 break;
5242 /* If not found, create a new image and cache it. */
5243 if (img == NULL)
5245 extern Lisp_Object Qpostscript;
5247 BLOCK_INPUT;
5248 img = make_image (spec, hash);
5249 cache_image (f, img);
5250 img->load_failed_p = img->type->load (f, img) == 0;
5252 /* If we can't load the image, and we don't have a width and
5253 height, use some arbitrary width and height so that we can
5254 draw a rectangle for it. */
5255 if (img->load_failed_p)
5257 Lisp_Object value;
5259 value = image_spec_value (spec, QCwidth, NULL);
5260 img->width = (INTEGERP (value)
5261 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
5262 value = image_spec_value (spec, QCheight, NULL);
5263 img->height = (INTEGERP (value)
5264 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
5266 else
5268 /* Handle image type independent image attributes
5269 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
5270 `:background COLOR'. */
5271 Lisp_Object ascent, margin, relief, bg;
5273 ascent = image_spec_value (spec, QCascent, NULL);
5274 if (INTEGERP (ascent))
5275 img->ascent = XFASTINT (ascent);
5276 else if (EQ (ascent, Qcenter))
5277 img->ascent = CENTERED_IMAGE_ASCENT;
5279 margin = image_spec_value (spec, QCmargin, NULL);
5280 if (INTEGERP (margin) && XINT (margin) >= 0)
5281 img->vmargin = img->hmargin = XFASTINT (margin);
5282 else if (CONSP (margin) && INTEGERP (XCAR (margin))
5283 && INTEGERP (XCDR (margin)))
5285 if (XINT (XCAR (margin)) > 0)
5286 img->hmargin = XFASTINT (XCAR (margin));
5287 if (XINT (XCDR (margin)) > 0)
5288 img->vmargin = XFASTINT (XCDR (margin));
5291 relief = image_spec_value (spec, QCrelief, NULL);
5292 if (INTEGERP (relief))
5294 img->relief = XINT (relief);
5295 img->hmargin += abs (img->relief);
5296 img->vmargin += abs (img->relief);
5299 if (! img->background_valid)
5301 bg = image_spec_value (img->spec, QCbackground, NULL);
5302 if (!NILP (bg))
5304 img->background
5305 = x_alloc_image_color (f, img, bg,
5306 FRAME_BACKGROUND_PIXEL (f));
5307 img->background_valid = 1;
5311 /* Do image transformations and compute masks, unless we
5312 don't have the image yet. */
5313 if (!EQ (*img->type->type, Qpostscript))
5314 postprocess_image (f, img);
5317 UNBLOCK_INPUT;
5318 xassert (!interrupt_input_blocked);
5321 /* We're using IMG, so set its timestamp to `now'. */
5322 EMACS_GET_TIME (now);
5323 img->timestamp = EMACS_SECS (now);
5325 UNGCPRO;
5327 /* Value is the image id. */
5328 return img->id;
5332 /* Cache image IMG in the image cache of frame F. */
5334 static void
5335 cache_image (f, img)
5336 struct frame *f;
5337 struct image *img;
5339 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5340 int i;
5342 /* Find a free slot in c->images. */
5343 for (i = 0; i < c->used; ++i)
5344 if (c->images[i] == NULL)
5345 break;
5347 /* If no free slot found, maybe enlarge c->images. */
5348 if (i == c->used && c->used == c->size)
5350 c->size *= 2;
5351 c->images = (struct image **) xrealloc (c->images,
5352 c->size * sizeof *c->images);
5355 /* Add IMG to c->images, and assign IMG an id. */
5356 c->images[i] = img;
5357 img->id = i;
5358 if (i == c->used)
5359 ++c->used;
5361 /* Add IMG to the cache's hash table. */
5362 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
5363 img->next = c->buckets[i];
5364 if (img->next)
5365 img->next->prev = img;
5366 img->prev = NULL;
5367 c->buckets[i] = img;
5371 /* Call FN on every image in the image cache of frame F. Used to mark
5372 Lisp Objects in the image cache. */
5374 void
5375 forall_images_in_image_cache (f, fn)
5376 struct frame *f;
5377 void (*fn) P_ ((struct image *img));
5379 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
5381 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5382 if (c)
5384 int i;
5385 for (i = 0; i < c->used; ++i)
5386 if (c->images[i])
5387 fn (c->images[i]);
5394 /***********************************************************************
5395 X support code
5396 ***********************************************************************/
5398 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
5399 XImage **, Pixmap *));
5400 static void x_destroy_x_image P_ ((XImage *));
5401 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
5404 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5405 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5406 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5407 via xmalloc. Print error messages via image_error if an error
5408 occurs. Value is non-zero if successful. */
5410 static int
5411 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
5412 struct frame *f;
5413 int width, height, depth;
5414 XImage **ximg;
5415 Pixmap *pixmap;
5417 Display *display = FRAME_X_DISPLAY (f);
5418 Screen *screen = FRAME_X_SCREEN (f);
5419 Window window = FRAME_X_WINDOW (f);
5421 xassert (interrupt_input_blocked);
5423 if (depth <= 0)
5424 depth = DefaultDepthOfScreen (screen);
5425 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
5426 depth, ZPixmap, 0, NULL, width, height,
5427 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
5428 if (*ximg == NULL)
5430 image_error ("Unable to allocate X image", Qnil, Qnil);
5431 return 0;
5434 /* Allocate image raster. */
5435 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
5437 /* Allocate a pixmap of the same size. */
5438 *pixmap = XCreatePixmap (display, window, width, height, depth);
5439 if (*pixmap == None)
5441 x_destroy_x_image (*ximg);
5442 *ximg = NULL;
5443 image_error ("Unable to create X pixmap", Qnil, Qnil);
5444 return 0;
5447 return 1;
5451 /* Destroy XImage XIMG. Free XIMG->data. */
5453 static void
5454 x_destroy_x_image (ximg)
5455 XImage *ximg;
5457 xassert (interrupt_input_blocked);
5458 if (ximg)
5460 xfree (ximg->data);
5461 ximg->data = NULL;
5462 XDestroyImage (ximg);
5467 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5468 are width and height of both the image and pixmap. */
5470 static void
5471 x_put_x_image (f, ximg, pixmap, width, height)
5472 struct frame *f;
5473 XImage *ximg;
5474 Pixmap pixmap;
5475 int width, height;
5477 GC gc;
5479 xassert (interrupt_input_blocked);
5480 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
5481 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
5482 XFreeGC (FRAME_X_DISPLAY (f), gc);
5487 /***********************************************************************
5488 File Handling
5489 ***********************************************************************/
5491 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5492 static char *slurp_file P_ ((char *, int *));
5495 /* Find image file FILE. Look in data-directory, then
5496 x-bitmap-file-path. Value is the full name of the file found, or
5497 nil if not found. */
5499 static Lisp_Object
5500 x_find_image_file (file)
5501 Lisp_Object file;
5503 Lisp_Object file_found, search_path;
5504 struct gcpro gcpro1, gcpro2;
5505 int fd;
5507 file_found = Qnil;
5508 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
5509 GCPRO2 (file_found, search_path);
5511 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5512 fd = openp (search_path, file, Qnil, &file_found, Qnil);
5514 if (fd == -1)
5515 file_found = Qnil;
5516 else
5517 close (fd);
5519 UNGCPRO;
5520 return file_found;
5524 /* Read FILE into memory. Value is a pointer to a buffer allocated
5525 with xmalloc holding FILE's contents. Value is null if an error
5526 occurred. *SIZE is set to the size of the file. */
5528 static char *
5529 slurp_file (file, size)
5530 char *file;
5531 int *size;
5533 FILE *fp = NULL;
5534 char *buf = NULL;
5535 struct stat st;
5537 if (stat (file, &st) == 0
5538 && (fp = fopen (file, "r")) != NULL
5539 && (buf = (char *) xmalloc (st.st_size),
5540 fread (buf, 1, st.st_size, fp) == st.st_size))
5542 *size = st.st_size;
5543 fclose (fp);
5545 else
5547 if (fp)
5548 fclose (fp);
5549 if (buf)
5551 xfree (buf);
5552 buf = NULL;
5556 return buf;
5561 /***********************************************************************
5562 XBM images
5563 ***********************************************************************/
5565 static int xbm_scan P_ ((char **, char *, char *, int *));
5566 static int xbm_load P_ ((struct frame *f, struct image *img));
5567 static int xbm_load_image P_ ((struct frame *f, struct image *img,
5568 char *, char *));
5569 static int xbm_image_p P_ ((Lisp_Object object));
5570 static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
5571 unsigned char **));
5572 static int xbm_file_p P_ ((Lisp_Object));
5575 /* Indices of image specification fields in xbm_format, below. */
5577 enum xbm_keyword_index
5579 XBM_TYPE,
5580 XBM_FILE,
5581 XBM_WIDTH,
5582 XBM_HEIGHT,
5583 XBM_DATA,
5584 XBM_FOREGROUND,
5585 XBM_BACKGROUND,
5586 XBM_ASCENT,
5587 XBM_MARGIN,
5588 XBM_RELIEF,
5589 XBM_ALGORITHM,
5590 XBM_HEURISTIC_MASK,
5591 XBM_MASK,
5592 XBM_LAST
5595 /* Vector of image_keyword structures describing the format
5596 of valid XBM image specifications. */
5598 static struct image_keyword xbm_format[XBM_LAST] =
5600 {":type", IMAGE_SYMBOL_VALUE, 1},
5601 {":file", IMAGE_STRING_VALUE, 0},
5602 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5603 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
5604 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5605 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
5606 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
5607 {":ascent", IMAGE_ASCENT_VALUE, 0},
5608 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
5609 {":relief", IMAGE_INTEGER_VALUE, 0},
5610 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5611 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
5612 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
5615 /* Structure describing the image type XBM. */
5617 static struct image_type xbm_type =
5619 &Qxbm,
5620 xbm_image_p,
5621 xbm_load,
5622 x_clear_image,
5623 NULL
5626 /* Tokens returned from xbm_scan. */
5628 enum xbm_token
5630 XBM_TK_IDENT = 256,
5631 XBM_TK_NUMBER
5635 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5636 A valid specification is a list starting with the symbol `image'
5637 The rest of the list is a property list which must contain an
5638 entry `:type xbm..
5640 If the specification specifies a file to load, it must contain
5641 an entry `:file FILENAME' where FILENAME is a string.
5643 If the specification is for a bitmap loaded from memory it must
5644 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5645 WIDTH and HEIGHT are integers > 0. DATA may be:
5647 1. a string large enough to hold the bitmap data, i.e. it must
5648 have a size >= (WIDTH + 7) / 8 * HEIGHT
5650 2. a bool-vector of size >= WIDTH * HEIGHT
5652 3. a vector of strings or bool-vectors, one for each line of the
5653 bitmap.
5655 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5656 may not be specified in this case because they are defined in the
5657 XBM file.
5659 Both the file and data forms may contain the additional entries
5660 `:background COLOR' and `:foreground COLOR'. If not present,
5661 foreground and background of the frame on which the image is
5662 displayed is used. */
5664 static int
5665 xbm_image_p (object)
5666 Lisp_Object object;
5668 struct image_keyword kw[XBM_LAST];
5670 bcopy (xbm_format, kw, sizeof kw);
5671 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
5672 return 0;
5674 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
5676 if (kw[XBM_FILE].count)
5678 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
5679 return 0;
5681 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
5683 /* In-memory XBM file. */
5684 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
5685 return 0;
5687 else
5689 Lisp_Object data;
5690 int width, height;
5692 /* Entries for `:width', `:height' and `:data' must be present. */
5693 if (!kw[XBM_WIDTH].count
5694 || !kw[XBM_HEIGHT].count
5695 || !kw[XBM_DATA].count)
5696 return 0;
5698 data = kw[XBM_DATA].value;
5699 width = XFASTINT (kw[XBM_WIDTH].value);
5700 height = XFASTINT (kw[XBM_HEIGHT].value);
5702 /* Check type of data, and width and height against contents of
5703 data. */
5704 if (VECTORP (data))
5706 int i;
5708 /* Number of elements of the vector must be >= height. */
5709 if (XVECTOR (data)->size < height)
5710 return 0;
5712 /* Each string or bool-vector in data must be large enough
5713 for one line of the image. */
5714 for (i = 0; i < height; ++i)
5716 Lisp_Object elt = XVECTOR (data)->contents[i];
5718 if (STRINGP (elt))
5720 if (SCHARS (elt)
5721 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
5722 return 0;
5724 else if (BOOL_VECTOR_P (elt))
5726 if (XBOOL_VECTOR (elt)->size < width)
5727 return 0;
5729 else
5730 return 0;
5733 else if (STRINGP (data))
5735 if (SCHARS (data)
5736 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
5737 return 0;
5739 else if (BOOL_VECTOR_P (data))
5741 if (XBOOL_VECTOR (data)->size < width * height)
5742 return 0;
5744 else
5745 return 0;
5748 return 1;
5752 /* Scan a bitmap file. FP is the stream to read from. Value is
5753 either an enumerator from enum xbm_token, or a character for a
5754 single-character token, or 0 at end of file. If scanning an
5755 identifier, store the lexeme of the identifier in SVAL. If
5756 scanning a number, store its value in *IVAL. */
5758 static int
5759 xbm_scan (s, end, sval, ival)
5760 char **s, *end;
5761 char *sval;
5762 int *ival;
5764 int c;
5766 loop:
5768 /* Skip white space. */
5769 while (*s < end && (c = *(*s)++, isspace (c)))
5772 if (*s >= end)
5773 c = 0;
5774 else if (isdigit (c))
5776 int value = 0, digit;
5778 if (c == '0' && *s < end)
5780 c = *(*s)++;
5781 if (c == 'x' || c == 'X')
5783 while (*s < end)
5785 c = *(*s)++;
5786 if (isdigit (c))
5787 digit = c - '0';
5788 else if (c >= 'a' && c <= 'f')
5789 digit = c - 'a' + 10;
5790 else if (c >= 'A' && c <= 'F')
5791 digit = c - 'A' + 10;
5792 else
5793 break;
5794 value = 16 * value + digit;
5797 else if (isdigit (c))
5799 value = c - '0';
5800 while (*s < end
5801 && (c = *(*s)++, isdigit (c)))
5802 value = 8 * value + c - '0';
5805 else
5807 value = c - '0';
5808 while (*s < end
5809 && (c = *(*s)++, isdigit (c)))
5810 value = 10 * value + c - '0';
5813 if (*s < end)
5814 *s = *s - 1;
5815 *ival = value;
5816 c = XBM_TK_NUMBER;
5818 else if (isalpha (c) || c == '_')
5820 *sval++ = c;
5821 while (*s < end
5822 && (c = *(*s)++, (isalnum (c) || c == '_')))
5823 *sval++ = c;
5824 *sval = 0;
5825 if (*s < end)
5826 *s = *s - 1;
5827 c = XBM_TK_IDENT;
5829 else if (c == '/' && **s == '*')
5831 /* C-style comment. */
5832 ++*s;
5833 while (**s && (**s != '*' || *(*s + 1) != '/'))
5834 ++*s;
5835 if (**s)
5837 *s += 2;
5838 goto loop;
5842 return c;
5846 /* Replacement for XReadBitmapFileData which isn't available under old
5847 X versions. CONTENTS is a pointer to a buffer to parse; END is the
5848 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
5849 the image. Return in *DATA the bitmap data allocated with xmalloc.
5850 Value is non-zero if successful. DATA null means just test if
5851 CONTENTS looks like an in-memory XBM file. */
5853 static int
5854 xbm_read_bitmap_data (contents, end, width, height, data)
5855 char *contents, *end;
5856 int *width, *height;
5857 unsigned char **data;
5859 char *s = contents;
5860 char buffer[BUFSIZ];
5861 int padding_p = 0;
5862 int v10 = 0;
5863 int bytes_per_line, i, nbytes;
5864 unsigned char *p;
5865 int value;
5866 int LA1;
5868 #define match() \
5869 LA1 = xbm_scan (&s, end, buffer, &value)
5871 #define expect(TOKEN) \
5872 if (LA1 != (TOKEN)) \
5873 goto failure; \
5874 else \
5875 match ()
5877 #define expect_ident(IDENT) \
5878 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
5879 match (); \
5880 else \
5881 goto failure
5883 *width = *height = -1;
5884 if (data)
5885 *data = NULL;
5886 LA1 = xbm_scan (&s, end, buffer, &value);
5888 /* Parse defines for width, height and hot-spots. */
5889 while (LA1 == '#')
5891 match ();
5892 expect_ident ("define");
5893 expect (XBM_TK_IDENT);
5895 if (LA1 == XBM_TK_NUMBER);
5897 char *p = strrchr (buffer, '_');
5898 p = p ? p + 1 : buffer;
5899 if (strcmp (p, "width") == 0)
5900 *width = value;
5901 else if (strcmp (p, "height") == 0)
5902 *height = value;
5904 expect (XBM_TK_NUMBER);
5907 if (*width < 0 || *height < 0)
5908 goto failure;
5909 else if (data == NULL)
5910 goto success;
5912 /* Parse bits. Must start with `static'. */
5913 expect_ident ("static");
5914 if (LA1 == XBM_TK_IDENT)
5916 if (strcmp (buffer, "unsigned") == 0)
5918 match ();
5919 expect_ident ("char");
5921 else if (strcmp (buffer, "short") == 0)
5923 match ();
5924 v10 = 1;
5925 if (*width % 16 && *width % 16 < 9)
5926 padding_p = 1;
5928 else if (strcmp (buffer, "char") == 0)
5929 match ();
5930 else
5931 goto failure;
5933 else
5934 goto failure;
5936 expect (XBM_TK_IDENT);
5937 expect ('[');
5938 expect (']');
5939 expect ('=');
5940 expect ('{');
5942 bytes_per_line = (*width + 7) / 8 + padding_p;
5943 nbytes = bytes_per_line * *height;
5944 p = *data = (char *) xmalloc (nbytes);
5946 if (v10)
5948 for (i = 0; i < nbytes; i += 2)
5950 int val = value;
5951 expect (XBM_TK_NUMBER);
5953 *p++ = val;
5954 if (!padding_p || ((i + 2) % bytes_per_line))
5955 *p++ = value >> 8;
5957 if (LA1 == ',' || LA1 == '}')
5958 match ();
5959 else
5960 goto failure;
5963 else
5965 for (i = 0; i < nbytes; ++i)
5967 int val = value;
5968 expect (XBM_TK_NUMBER);
5970 *p++ = val;
5972 if (LA1 == ',' || LA1 == '}')
5973 match ();
5974 else
5975 goto failure;
5979 success:
5980 return 1;
5982 failure:
5984 if (data && *data)
5986 xfree (*data);
5987 *data = NULL;
5989 return 0;
5991 #undef match
5992 #undef expect
5993 #undef expect_ident
5997 /* Load XBM image IMG which will be displayed on frame F from buffer
5998 CONTENTS. END is the end of the buffer. Value is non-zero if
5999 successful. */
6001 static int
6002 xbm_load_image (f, img, contents, end)
6003 struct frame *f;
6004 struct image *img;
6005 char *contents, *end;
6007 int rc;
6008 unsigned char *data;
6009 int success_p = 0;
6011 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6012 if (rc)
6014 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6015 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6016 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6017 Lisp_Object value;
6019 xassert (img->width > 0 && img->height > 0);
6021 /* Get foreground and background colors, maybe allocate colors. */
6022 value = image_spec_value (img->spec, QCforeground, NULL);
6023 if (!NILP (value))
6024 foreground = x_alloc_image_color (f, img, value, foreground);
6025 value = image_spec_value (img->spec, QCbackground, NULL);
6026 if (!NILP (value))
6028 background = x_alloc_image_color (f, img, value, background);
6029 img->background = background;
6030 img->background_valid = 1;
6033 img->pixmap
6034 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6035 FRAME_X_WINDOW (f),
6036 data,
6037 img->width, img->height,
6038 foreground, background,
6039 depth);
6040 xfree (data);
6042 if (img->pixmap == None)
6044 x_clear_image (f, img);
6045 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6047 else
6048 success_p = 1;
6050 else
6051 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6053 return success_p;
6057 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6059 static int
6060 xbm_file_p (data)
6061 Lisp_Object data;
6063 int w, h;
6064 return (STRINGP (data)
6065 && xbm_read_bitmap_data (SDATA (data),
6066 (SDATA (data)
6067 + SBYTES (data)),
6068 &w, &h, NULL));
6072 /* Fill image IMG which is used on frame F with pixmap data. Value is
6073 non-zero if successful. */
6075 static int
6076 xbm_load (f, img)
6077 struct frame *f;
6078 struct image *img;
6080 int success_p = 0;
6081 Lisp_Object file_name;
6083 xassert (xbm_image_p (img->spec));
6085 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6086 file_name = image_spec_value (img->spec, QCfile, NULL);
6087 if (STRINGP (file_name))
6089 Lisp_Object file;
6090 char *contents;
6091 int size;
6092 struct gcpro gcpro1;
6094 file = x_find_image_file (file_name);
6095 GCPRO1 (file);
6096 if (!STRINGP (file))
6098 image_error ("Cannot find image file `%s'", file_name, Qnil);
6099 UNGCPRO;
6100 return 0;
6103 contents = slurp_file (SDATA (file), &size);
6104 if (contents == NULL)
6106 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6107 UNGCPRO;
6108 return 0;
6111 success_p = xbm_load_image (f, img, contents, contents + size);
6112 UNGCPRO;
6114 else
6116 struct image_keyword fmt[XBM_LAST];
6117 Lisp_Object data;
6118 int depth;
6119 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6120 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6121 char *bits;
6122 int parsed_p;
6123 int in_memory_file_p = 0;
6125 /* See if data looks like an in-memory XBM file. */
6126 data = image_spec_value (img->spec, QCdata, NULL);
6127 in_memory_file_p = xbm_file_p (data);
6129 /* Parse the image specification. */
6130 bcopy (xbm_format, fmt, sizeof fmt);
6131 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
6132 xassert (parsed_p);
6134 /* Get specified width, and height. */
6135 if (!in_memory_file_p)
6137 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6138 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6139 xassert (img->width > 0 && img->height > 0);
6142 /* Get foreground and background colors, maybe allocate colors. */
6143 if (fmt[XBM_FOREGROUND].count
6144 && STRINGP (fmt[XBM_FOREGROUND].value))
6145 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6146 foreground);
6147 if (fmt[XBM_BACKGROUND].count
6148 && STRINGP (fmt[XBM_BACKGROUND].value))
6149 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6150 background);
6152 if (in_memory_file_p)
6153 success_p = xbm_load_image (f, img, SDATA (data),
6154 (SDATA (data)
6155 + SBYTES (data)));
6156 else
6158 if (VECTORP (data))
6160 int i;
6161 char *p;
6162 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6164 p = bits = (char *) alloca (nbytes * img->height);
6165 for (i = 0; i < img->height; ++i, p += nbytes)
6167 Lisp_Object line = XVECTOR (data)->contents[i];
6168 if (STRINGP (line))
6169 bcopy (SDATA (line), p, nbytes);
6170 else
6171 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6174 else if (STRINGP (data))
6175 bits = SDATA (data);
6176 else
6177 bits = XBOOL_VECTOR (data)->data;
6179 /* Create the pixmap. */
6180 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6181 img->pixmap
6182 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6183 FRAME_X_WINDOW (f),
6184 bits,
6185 img->width, img->height,
6186 foreground, background,
6187 depth);
6188 if (img->pixmap)
6189 success_p = 1;
6190 else
6192 image_error ("Unable to create pixmap for XBM image `%s'",
6193 img->spec, Qnil);
6194 x_clear_image (f, img);
6199 return success_p;
6204 /***********************************************************************
6205 XPM images
6206 ***********************************************************************/
6208 #if HAVE_XPM
6210 static int xpm_image_p P_ ((Lisp_Object object));
6211 static int xpm_load P_ ((struct frame *f, struct image *img));
6212 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6214 #include "X11/xpm.h"
6216 /* The symbol `xpm' identifying XPM-format images. */
6218 Lisp_Object Qxpm;
6220 /* Indices of image specification fields in xpm_format, below. */
6222 enum xpm_keyword_index
6224 XPM_TYPE,
6225 XPM_FILE,
6226 XPM_DATA,
6227 XPM_ASCENT,
6228 XPM_MARGIN,
6229 XPM_RELIEF,
6230 XPM_ALGORITHM,
6231 XPM_HEURISTIC_MASK,
6232 XPM_MASK,
6233 XPM_COLOR_SYMBOLS,
6234 XPM_BACKGROUND,
6235 XPM_LAST
6238 /* Vector of image_keyword structures describing the format
6239 of valid XPM image specifications. */
6241 static struct image_keyword xpm_format[XPM_LAST] =
6243 {":type", IMAGE_SYMBOL_VALUE, 1},
6244 {":file", IMAGE_STRING_VALUE, 0},
6245 {":data", IMAGE_STRING_VALUE, 0},
6246 {":ascent", IMAGE_ASCENT_VALUE, 0},
6247 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6248 {":relief", IMAGE_INTEGER_VALUE, 0},
6249 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6250 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6251 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6252 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6253 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6256 /* Structure describing the image type XBM. */
6258 static struct image_type xpm_type =
6260 &Qxpm,
6261 xpm_image_p,
6262 xpm_load,
6263 x_clear_image,
6264 NULL
6268 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6269 functions for allocating image colors. Our own functions handle
6270 color allocation failures more gracefully than the ones on the XPM
6271 lib. */
6273 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6274 #define ALLOC_XPM_COLORS
6275 #endif
6277 #ifdef ALLOC_XPM_COLORS
6279 static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
6280 static void xpm_free_color_cache P_ ((void));
6281 static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
6282 static int xpm_color_bucket P_ ((char *));
6283 static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
6284 XColor *, int));
6286 /* An entry in a hash table used to cache color definitions of named
6287 colors. This cache is necessary to speed up XPM image loading in
6288 case we do color allocations ourselves. Without it, we would need
6289 a call to XParseColor per pixel in the image. */
6291 struct xpm_cached_color
6293 /* Next in collision chain. */
6294 struct xpm_cached_color *next;
6296 /* Color definition (RGB and pixel color). */
6297 XColor color;
6299 /* Color name. */
6300 char name[1];
6303 /* The hash table used for the color cache, and its bucket vector
6304 size. */
6306 #define XPM_COLOR_CACHE_BUCKETS 1001
6307 struct xpm_cached_color **xpm_color_cache;
6309 /* Initialize the color cache. */
6311 static void
6312 xpm_init_color_cache (f, attrs)
6313 struct frame *f;
6314 XpmAttributes *attrs;
6316 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
6317 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
6318 memset (xpm_color_cache, 0, nbytes);
6319 init_color_table ();
6321 if (attrs->valuemask & XpmColorSymbols)
6323 int i;
6324 XColor color;
6326 for (i = 0; i < attrs->numsymbols; ++i)
6327 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6328 attrs->colorsymbols[i].value, &color))
6330 color.pixel = lookup_rgb_color (f, color.red, color.green,
6331 color.blue);
6332 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
6338 /* Free the color cache. */
6340 static void
6341 xpm_free_color_cache ()
6343 struct xpm_cached_color *p, *next;
6344 int i;
6346 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
6347 for (p = xpm_color_cache[i]; p; p = next)
6349 next = p->next;
6350 xfree (p);
6353 xfree (xpm_color_cache);
6354 xpm_color_cache = NULL;
6355 free_color_table ();
6359 /* Return the bucket index for color named COLOR_NAME in the color
6360 cache. */
6362 static int
6363 xpm_color_bucket (color_name)
6364 char *color_name;
6366 unsigned h = 0;
6367 char *s;
6369 for (s = color_name; *s; ++s)
6370 h = (h << 2) ^ *s;
6371 return h %= XPM_COLOR_CACHE_BUCKETS;
6375 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6376 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6377 entry added. */
6379 static struct xpm_cached_color *
6380 xpm_cache_color (f, color_name, color, bucket)
6381 struct frame *f;
6382 char *color_name;
6383 XColor *color;
6384 int bucket;
6386 size_t nbytes;
6387 struct xpm_cached_color *p;
6389 if (bucket < 0)
6390 bucket = xpm_color_bucket (color_name);
6392 nbytes = sizeof *p + strlen (color_name);
6393 p = (struct xpm_cached_color *) xmalloc (nbytes);
6394 strcpy (p->name, color_name);
6395 p->color = *color;
6396 p->next = xpm_color_cache[bucket];
6397 xpm_color_cache[bucket] = p;
6398 return p;
6402 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6403 return the cached definition in *COLOR. Otherwise, make a new
6404 entry in the cache and allocate the color. Value is zero if color
6405 allocation failed. */
6407 static int
6408 xpm_lookup_color (f, color_name, color)
6409 struct frame *f;
6410 char *color_name;
6411 XColor *color;
6413 struct xpm_cached_color *p;
6414 int h = xpm_color_bucket (color_name);
6416 for (p = xpm_color_cache[h]; p; p = p->next)
6417 if (strcmp (p->name, color_name) == 0)
6418 break;
6420 if (p != NULL)
6421 *color = p->color;
6422 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
6423 color_name, color))
6425 color->pixel = lookup_rgb_color (f, color->red, color->green,
6426 color->blue);
6427 p = xpm_cache_color (f, color_name, color, h);
6429 /* You get `opaque' at least from ImageMagick converting pbm to xpm
6430 with transparency, and it's useful. */
6431 else if (strcmp ("opaque", color_name) == 0)
6433 bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
6434 color->pixel = FRAME_FOREGROUND_PIXEL (f);
6435 p = xpm_cache_color (f, color_name, color, h);
6438 return p != NULL;
6442 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6443 CLOSURE is a pointer to the frame on which we allocate the
6444 color. Return in *COLOR the allocated color. Value is non-zero
6445 if successful. */
6447 static int
6448 xpm_alloc_color (dpy, cmap, color_name, color, closure)
6449 Display *dpy;
6450 Colormap cmap;
6451 char *color_name;
6452 XColor *color;
6453 void *closure;
6455 return xpm_lookup_color ((struct frame *) closure, color_name, color);
6459 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6460 is a pointer to the frame on which we allocate the color. Value is
6461 non-zero if successful. */
6463 static int
6464 xpm_free_colors (dpy, cmap, pixels, npixels, closure)
6465 Display *dpy;
6466 Colormap cmap;
6467 Pixel *pixels;
6468 int npixels;
6469 void *closure;
6471 return 1;
6474 #endif /* ALLOC_XPM_COLORS */
6477 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6478 for XPM images. Such a list must consist of conses whose car and
6479 cdr are strings. */
6481 static int
6482 xpm_valid_color_symbols_p (color_symbols)
6483 Lisp_Object color_symbols;
6485 while (CONSP (color_symbols))
6487 Lisp_Object sym = XCAR (color_symbols);
6488 if (!CONSP (sym)
6489 || !STRINGP (XCAR (sym))
6490 || !STRINGP (XCDR (sym)))
6491 break;
6492 color_symbols = XCDR (color_symbols);
6495 return NILP (color_symbols);
6499 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6501 static int
6502 xpm_image_p (object)
6503 Lisp_Object object;
6505 struct image_keyword fmt[XPM_LAST];
6506 bcopy (xpm_format, fmt, sizeof fmt);
6507 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
6508 /* Either `:file' or `:data' must be present. */
6509 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6510 /* Either no `:color-symbols' or it's a list of conses
6511 whose car and cdr are strings. */
6512 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6513 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
6517 /* Load image IMG which will be displayed on frame F. Value is
6518 non-zero if successful. */
6520 static int
6521 xpm_load (f, img)
6522 struct frame *f;
6523 struct image *img;
6525 int rc;
6526 XpmAttributes attrs;
6527 Lisp_Object specified_file, color_symbols;
6529 /* Configure the XPM lib. Use the visual of frame F. Allocate
6530 close colors. Return colors allocated. */
6531 bzero (&attrs, sizeof attrs);
6532 attrs.visual = FRAME_X_VISUAL (f);
6533 attrs.colormap = FRAME_X_COLORMAP (f);
6534 attrs.valuemask |= XpmVisual;
6535 attrs.valuemask |= XpmColormap;
6537 #ifdef ALLOC_XPM_COLORS
6538 /* Allocate colors with our own functions which handle
6539 failing color allocation more gracefully. */
6540 attrs.color_closure = f;
6541 attrs.alloc_color = xpm_alloc_color;
6542 attrs.free_colors = xpm_free_colors;
6543 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
6544 #else /* not ALLOC_XPM_COLORS */
6545 /* Let the XPM lib allocate colors. */
6546 attrs.valuemask |= XpmReturnAllocPixels;
6547 #ifdef XpmAllocCloseColors
6548 attrs.alloc_close_colors = 1;
6549 attrs.valuemask |= XpmAllocCloseColors;
6550 #else /* not XpmAllocCloseColors */
6551 attrs.closeness = 600;
6552 attrs.valuemask |= XpmCloseness;
6553 #endif /* not XpmAllocCloseColors */
6554 #endif /* ALLOC_XPM_COLORS */
6556 /* If image specification contains symbolic color definitions, add
6557 these to `attrs'. */
6558 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6559 if (CONSP (color_symbols))
6561 Lisp_Object tail;
6562 XpmColorSymbol *xpm_syms;
6563 int i, size;
6565 attrs.valuemask |= XpmColorSymbols;
6567 /* Count number of symbols. */
6568 attrs.numsymbols = 0;
6569 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6570 ++attrs.numsymbols;
6572 /* Allocate an XpmColorSymbol array. */
6573 size = attrs.numsymbols * sizeof *xpm_syms;
6574 xpm_syms = (XpmColorSymbol *) alloca (size);
6575 bzero (xpm_syms, size);
6576 attrs.colorsymbols = xpm_syms;
6578 /* Fill the color symbol array. */
6579 for (tail = color_symbols, i = 0;
6580 CONSP (tail);
6581 ++i, tail = XCDR (tail))
6583 Lisp_Object name = XCAR (XCAR (tail));
6584 Lisp_Object color = XCDR (XCAR (tail));
6585 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
6586 strcpy (xpm_syms[i].name, SDATA (name));
6587 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
6588 strcpy (xpm_syms[i].value, SDATA (color));
6592 /* Create a pixmap for the image, either from a file, or from a
6593 string buffer containing data in the same format as an XPM file. */
6594 #ifdef ALLOC_XPM_COLORS
6595 xpm_init_color_cache (f, &attrs);
6596 #endif
6598 specified_file = image_spec_value (img->spec, QCfile, NULL);
6599 if (STRINGP (specified_file))
6601 Lisp_Object file = x_find_image_file (specified_file);
6602 if (!STRINGP (file))
6604 image_error ("Cannot find image file `%s'", specified_file, Qnil);
6605 return 0;
6608 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6609 SDATA (file), &img->pixmap, &img->mask,
6610 &attrs);
6612 else
6614 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
6615 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
6616 SDATA (buffer),
6617 &img->pixmap, &img->mask,
6618 &attrs);
6621 if (rc == XpmSuccess)
6623 #ifdef ALLOC_XPM_COLORS
6624 img->colors = colors_in_color_table (&img->ncolors);
6625 #else /* not ALLOC_XPM_COLORS */
6626 int i;
6628 img->ncolors = attrs.nalloc_pixels;
6629 img->colors = (unsigned long *) xmalloc (img->ncolors
6630 * sizeof *img->colors);
6631 for (i = 0; i < attrs.nalloc_pixels; ++i)
6633 img->colors[i] = attrs.alloc_pixels[i];
6634 #ifdef DEBUG_X_COLORS
6635 register_color (img->colors[i]);
6636 #endif
6638 #endif /* not ALLOC_XPM_COLORS */
6640 img->width = attrs.width;
6641 img->height = attrs.height;
6642 xassert (img->width > 0 && img->height > 0);
6644 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6645 XpmFreeAttributes (&attrs);
6647 else
6649 switch (rc)
6651 case XpmOpenFailed:
6652 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
6653 break;
6655 case XpmFileInvalid:
6656 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
6657 break;
6659 case XpmNoMemory:
6660 image_error ("Out of memory (%s)", img->spec, Qnil);
6661 break;
6663 case XpmColorFailed:
6664 image_error ("Color allocation error (%s)", img->spec, Qnil);
6665 break;
6667 default:
6668 image_error ("Unknown error (%s)", img->spec, Qnil);
6669 break;
6673 #ifdef ALLOC_XPM_COLORS
6674 xpm_free_color_cache ();
6675 #endif
6676 return rc == XpmSuccess;
6679 #endif /* HAVE_XPM != 0 */
6682 /***********************************************************************
6683 Color table
6684 ***********************************************************************/
6686 /* An entry in the color table mapping an RGB color to a pixel color. */
6688 struct ct_color
6690 int r, g, b;
6691 unsigned long pixel;
6693 /* Next in color table collision list. */
6694 struct ct_color *next;
6697 /* The bucket vector size to use. Must be prime. */
6699 #define CT_SIZE 101
6701 /* Value is a hash of the RGB color given by R, G, and B. */
6703 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6705 /* The color hash table. */
6707 struct ct_color **ct_table;
6709 /* Number of entries in the color table. */
6711 int ct_colors_allocated;
6713 /* Initialize the color table. */
6715 static void
6716 init_color_table ()
6718 int size = CT_SIZE * sizeof (*ct_table);
6719 ct_table = (struct ct_color **) xmalloc (size);
6720 bzero (ct_table, size);
6721 ct_colors_allocated = 0;
6725 /* Free memory associated with the color table. */
6727 static void
6728 free_color_table ()
6730 int i;
6731 struct ct_color *p, *next;
6733 for (i = 0; i < CT_SIZE; ++i)
6734 for (p = ct_table[i]; p; p = next)
6736 next = p->next;
6737 xfree (p);
6740 xfree (ct_table);
6741 ct_table = NULL;
6745 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6746 entry for that color already is in the color table, return the
6747 pixel color of that entry. Otherwise, allocate a new color for R,
6748 G, B, and make an entry in the color table. */
6750 static unsigned long
6751 lookup_rgb_color (f, r, g, b)
6752 struct frame *f;
6753 int r, g, b;
6755 unsigned hash = CT_HASH_RGB (r, g, b);
6756 int i = hash % CT_SIZE;
6757 struct ct_color *p;
6758 struct x_display_info *dpyinfo;
6760 /* Handle TrueColor visuals specially, which improves performance by
6761 two orders of magnitude. Freeing colors on TrueColor visuals is
6762 a nop, and pixel colors specify RGB values directly. See also
6763 the Xlib spec, chapter 3.1. */
6764 dpyinfo = FRAME_X_DISPLAY_INFO (f);
6765 if (dpyinfo->red_bits > 0)
6767 unsigned long pr, pg, pb;
6769 /* Apply gamma-correction like normal color allocation does. */
6770 if (f->gamma)
6772 XColor color;
6773 color.red = r, color.green = g, color.blue = b;
6774 gamma_correct (f, &color);
6775 r = color.red, g = color.green, b = color.blue;
6778 /* Scale down RGB values to the visual's bits per RGB, and shift
6779 them to the right position in the pixel color. Note that the
6780 original RGB values are 16-bit values, as usual in X. */
6781 pr = (r >> (16 - dpyinfo->red_bits)) << dpyinfo->red_offset;
6782 pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset;
6783 pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset;
6785 /* Assemble the pixel color. */
6786 return pr | pg | pb;
6789 for (p = ct_table[i]; p; p = p->next)
6790 if (p->r == r && p->g == g && p->b == b)
6791 break;
6793 if (p == NULL)
6795 XColor color;
6796 Colormap cmap;
6797 int rc;
6799 color.red = r;
6800 color.green = g;
6801 color.blue = b;
6803 cmap = FRAME_X_COLORMAP (f);
6804 rc = x_alloc_nearest_color (f, cmap, &color);
6806 if (rc)
6808 ++ct_colors_allocated;
6810 p = (struct ct_color *) xmalloc (sizeof *p);
6811 p->r = r;
6812 p->g = g;
6813 p->b = b;
6814 p->pixel = color.pixel;
6815 p->next = ct_table[i];
6816 ct_table[i] = p;
6818 else
6819 return FRAME_FOREGROUND_PIXEL (f);
6822 return p->pixel;
6826 /* Look up pixel color PIXEL which is used on frame F in the color
6827 table. If not already present, allocate it. Value is PIXEL. */
6829 static unsigned long
6830 lookup_pixel_color (f, pixel)
6831 struct frame *f;
6832 unsigned long pixel;
6834 int i = pixel % CT_SIZE;
6835 struct ct_color *p;
6837 for (p = ct_table[i]; p; p = p->next)
6838 if (p->pixel == pixel)
6839 break;
6841 if (p == NULL)
6843 XColor color;
6844 Colormap cmap;
6845 int rc;
6847 cmap = FRAME_X_COLORMAP (f);
6848 color.pixel = pixel;
6849 x_query_color (f, &color);
6850 rc = x_alloc_nearest_color (f, cmap, &color);
6852 if (rc)
6854 ++ct_colors_allocated;
6856 p = (struct ct_color *) xmalloc (sizeof *p);
6857 p->r = color.red;
6858 p->g = color.green;
6859 p->b = color.blue;
6860 p->pixel = pixel;
6861 p->next = ct_table[i];
6862 ct_table[i] = p;
6864 else
6865 return FRAME_FOREGROUND_PIXEL (f);
6868 return p->pixel;
6872 /* Value is a vector of all pixel colors contained in the color table,
6873 allocated via xmalloc. Set *N to the number of colors. */
6875 static unsigned long *
6876 colors_in_color_table (n)
6877 int *n;
6879 int i, j;
6880 struct ct_color *p;
6881 unsigned long *colors;
6883 if (ct_colors_allocated == 0)
6885 *n = 0;
6886 colors = NULL;
6888 else
6890 colors = (unsigned long *) xmalloc (ct_colors_allocated
6891 * sizeof *colors);
6892 *n = ct_colors_allocated;
6894 for (i = j = 0; i < CT_SIZE; ++i)
6895 for (p = ct_table[i]; p; p = p->next)
6896 colors[j++] = p->pixel;
6899 return colors;
6904 /***********************************************************************
6905 Algorithms
6906 ***********************************************************************/
6908 static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
6909 static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
6910 static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
6912 /* Non-zero means draw a cross on images having `:conversion
6913 disabled'. */
6915 int cross_disabled_images;
6917 /* Edge detection matrices for different edge-detection
6918 strategies. */
6920 static int emboss_matrix[9] = {
6921 /* x - 1 x x + 1 */
6922 2, -1, 0, /* y - 1 */
6923 -1, 0, 1, /* y */
6924 0, 1, -2 /* y + 1 */
6927 static int laplace_matrix[9] = {
6928 /* x - 1 x x + 1 */
6929 1, 0, 0, /* y - 1 */
6930 0, 0, 0, /* y */
6931 0, 0, -1 /* y + 1 */
6934 /* Value is the intensity of the color whose red/green/blue values
6935 are R, G, and B. */
6937 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
6940 /* On frame F, return an array of XColor structures describing image
6941 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
6942 non-zero means also fill the red/green/blue members of the XColor
6943 structures. Value is a pointer to the array of XColors structures,
6944 allocated with xmalloc; it must be freed by the caller. */
6946 static XColor *
6947 x_to_xcolors (f, img, rgb_p)
6948 struct frame *f;
6949 struct image *img;
6950 int rgb_p;
6952 int x, y;
6953 XColor *colors, *p;
6954 XImage *ximg;
6956 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
6958 /* Get the X image IMG->pixmap. */
6959 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
6960 0, 0, img->width, img->height, ~0, ZPixmap);
6962 /* Fill the `pixel' members of the XColor array. I wished there
6963 were an easy and portable way to circumvent XGetPixel. */
6964 p = colors;
6965 for (y = 0; y < img->height; ++y)
6967 XColor *row = p;
6969 for (x = 0; x < img->width; ++x, ++p)
6970 p->pixel = XGetPixel (ximg, x, y);
6972 if (rgb_p)
6973 x_query_colors (f, row, img->width);
6976 XDestroyImage (ximg);
6977 return colors;
6981 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
6982 RGB members are set. F is the frame on which this all happens.
6983 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6985 static void
6986 x_from_xcolors (f, img, colors)
6987 struct frame *f;
6988 struct image *img;
6989 XColor *colors;
6991 int x, y;
6992 XImage *oimg;
6993 Pixmap pixmap;
6994 XColor *p;
6996 init_color_table ();
6998 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
6999 &oimg, &pixmap);
7000 p = colors;
7001 for (y = 0; y < img->height; ++y)
7002 for (x = 0; x < img->width; ++x, ++p)
7004 unsigned long pixel;
7005 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7006 XPutPixel (oimg, x, y, pixel);
7009 xfree (colors);
7010 x_clear_image_1 (f, img, 1, 0, 1);
7012 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7013 x_destroy_x_image (oimg);
7014 img->pixmap = pixmap;
7015 img->colors = colors_in_color_table (&img->ncolors);
7016 free_color_table ();
7020 /* On frame F, perform edge-detection on image IMG.
7022 MATRIX is a nine-element array specifying the transformation
7023 matrix. See emboss_matrix for an example.
7025 COLOR_ADJUST is a color adjustment added to each pixel of the
7026 outgoing image. */
7028 static void
7029 x_detect_edges (f, img, matrix, color_adjust)
7030 struct frame *f;
7031 struct image *img;
7032 int matrix[9], color_adjust;
7034 XColor *colors = x_to_xcolors (f, img, 1);
7035 XColor *new, *p;
7036 int x, y, i, sum;
7038 for (i = sum = 0; i < 9; ++i)
7039 sum += abs (matrix[i]);
7041 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7043 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
7045 for (y = 0; y < img->height; ++y)
7047 p = COLOR (new, 0, y);
7048 p->red = p->green = p->blue = 0xffff/2;
7049 p = COLOR (new, img->width - 1, y);
7050 p->red = p->green = p->blue = 0xffff/2;
7053 for (x = 1; x < img->width - 1; ++x)
7055 p = COLOR (new, x, 0);
7056 p->red = p->green = p->blue = 0xffff/2;
7057 p = COLOR (new, x, img->height - 1);
7058 p->red = p->green = p->blue = 0xffff/2;
7061 for (y = 1; y < img->height - 1; ++y)
7063 p = COLOR (new, 1, y);
7065 for (x = 1; x < img->width - 1; ++x, ++p)
7067 int r, g, b, y1, x1;
7069 r = g = b = i = 0;
7070 for (y1 = y - 1; y1 < y + 2; ++y1)
7071 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7072 if (matrix[i])
7074 XColor *t = COLOR (colors, x1, y1);
7075 r += matrix[i] * t->red;
7076 g += matrix[i] * t->green;
7077 b += matrix[i] * t->blue;
7080 r = (r / sum + color_adjust) & 0xffff;
7081 g = (g / sum + color_adjust) & 0xffff;
7082 b = (b / sum + color_adjust) & 0xffff;
7083 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
7087 xfree (colors);
7088 x_from_xcolors (f, img, new);
7090 #undef COLOR
7094 /* Perform the pre-defined `emboss' edge-detection on image IMG
7095 on frame F. */
7097 static void
7098 x_emboss (f, img)
7099 struct frame *f;
7100 struct image *img;
7102 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7106 /* Perform the pre-defined `laplace' edge-detection on image IMG
7107 on frame F. */
7109 static void
7110 x_laplace (f, img)
7111 struct frame *f;
7112 struct image *img;
7114 x_detect_edges (f, img, laplace_matrix, 45000);
7118 /* Perform edge-detection on image IMG on frame F, with specified
7119 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7121 MATRIX must be either
7123 - a list of at least 9 numbers in row-major form
7124 - a vector of at least 9 numbers
7126 COLOR_ADJUST nil means use a default; otherwise it must be a
7127 number. */
7129 static void
7130 x_edge_detection (f, img, matrix, color_adjust)
7131 struct frame *f;
7132 struct image *img;
7133 Lisp_Object matrix, color_adjust;
7135 int i = 0;
7136 int trans[9];
7138 if (CONSP (matrix))
7140 for (i = 0;
7141 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7142 ++i, matrix = XCDR (matrix))
7143 trans[i] = XFLOATINT (XCAR (matrix));
7145 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7147 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7148 trans[i] = XFLOATINT (AREF (matrix, i));
7151 if (NILP (color_adjust))
7152 color_adjust = make_number (0xffff / 2);
7154 if (i == 9 && NUMBERP (color_adjust))
7155 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
7159 /* Transform image IMG on frame F so that it looks disabled. */
7161 static void
7162 x_disable_image (f, img)
7163 struct frame *f;
7164 struct image *img;
7166 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
7168 if (dpyinfo->n_planes >= 2)
7170 /* Color (or grayscale). Convert to gray, and equalize. Just
7171 drawing such images with a stipple can look very odd, so
7172 we're using this method instead. */
7173 XColor *colors = x_to_xcolors (f, img, 1);
7174 XColor *p, *end;
7175 const int h = 15000;
7176 const int l = 30000;
7178 for (p = colors, end = colors + img->width * img->height;
7179 p < end;
7180 ++p)
7182 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7183 int i2 = (0xffff - h - l) * i / 0xffff + l;
7184 p->red = p->green = p->blue = i2;
7187 x_from_xcolors (f, img, colors);
7190 /* Draw a cross over the disabled image, if we must or if we
7191 should. */
7192 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7194 Display *dpy = FRAME_X_DISPLAY (f);
7195 GC gc;
7197 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7198 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7199 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7200 img->width - 1, img->height - 1);
7201 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7202 img->width - 1, 0);
7203 XFreeGC (dpy, gc);
7205 if (img->mask)
7207 gc = XCreateGC (dpy, img->mask, 0, NULL);
7208 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
7209 XDrawLine (dpy, img->mask, gc, 0, 0,
7210 img->width - 1, img->height - 1);
7211 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
7212 img->width - 1, 0);
7213 XFreeGC (dpy, gc);
7219 /* Build a mask for image IMG which is used on frame F. FILE is the
7220 name of an image file, for error messages. HOW determines how to
7221 determine the background color of IMG. If it is a list '(R G B)',
7222 with R, G, and B being integers >= 0, take that as the color of the
7223 background. Otherwise, determine the background color of IMG
7224 heuristically. Value is non-zero if successful. */
7226 static int
7227 x_build_heuristic_mask (f, img, how)
7228 struct frame *f;
7229 struct image *img;
7230 Lisp_Object how;
7232 Display *dpy = FRAME_X_DISPLAY (f);
7233 XImage *ximg, *mask_img;
7234 int x, y, rc, use_img_background;
7235 unsigned long bg = 0;
7237 if (img->mask)
7239 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
7240 img->mask = None;
7241 img->background_transparent_valid = 0;
7244 /* Create an image and pixmap serving as mask. */
7245 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7246 &mask_img, &img->mask);
7247 if (!rc)
7248 return 0;
7250 /* Get the X image of IMG->pixmap. */
7251 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7252 ~0, ZPixmap);
7254 /* Determine the background color of ximg. If HOW is `(R G B)'
7255 take that as color. Otherwise, use the image's background color. */
7256 use_img_background = 1;
7258 if (CONSP (how))
7260 int rgb[3], i;
7262 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
7264 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7265 how = XCDR (how);
7268 if (i == 3 && NILP (how))
7270 char color_name[30];
7271 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7272 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
7273 use_img_background = 0;
7277 if (use_img_background)
7278 bg = four_corners_best (ximg, img->width, img->height);
7280 /* Set all bits in mask_img to 1 whose color in ximg is different
7281 from the background color bg. */
7282 for (y = 0; y < img->height; ++y)
7283 for (x = 0; x < img->width; ++x)
7284 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7286 /* Fill in the background_transparent field while we have the mask handy. */
7287 image_background_transparent (img, f, mask_img);
7289 /* Put mask_img into img->mask. */
7290 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7291 x_destroy_x_image (mask_img);
7292 XDestroyImage (ximg);
7294 return 1;
7299 /***********************************************************************
7300 PBM (mono, gray, color)
7301 ***********************************************************************/
7303 static int pbm_image_p P_ ((Lisp_Object object));
7304 static int pbm_load P_ ((struct frame *f, struct image *img));
7305 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7307 /* The symbol `pbm' identifying images of this type. */
7309 Lisp_Object Qpbm;
7311 /* Indices of image specification fields in gs_format, below. */
7313 enum pbm_keyword_index
7315 PBM_TYPE,
7316 PBM_FILE,
7317 PBM_DATA,
7318 PBM_ASCENT,
7319 PBM_MARGIN,
7320 PBM_RELIEF,
7321 PBM_ALGORITHM,
7322 PBM_HEURISTIC_MASK,
7323 PBM_MASK,
7324 PBM_FOREGROUND,
7325 PBM_BACKGROUND,
7326 PBM_LAST
7329 /* Vector of image_keyword structures describing the format
7330 of valid user-defined image specifications. */
7332 static struct image_keyword pbm_format[PBM_LAST] =
7334 {":type", IMAGE_SYMBOL_VALUE, 1},
7335 {":file", IMAGE_STRING_VALUE, 0},
7336 {":data", IMAGE_STRING_VALUE, 0},
7337 {":ascent", IMAGE_ASCENT_VALUE, 0},
7338 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7339 {":relief", IMAGE_INTEGER_VALUE, 0},
7340 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7341 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7342 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7343 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
7344 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7347 /* Structure describing the image type `pbm'. */
7349 static struct image_type pbm_type =
7351 &Qpbm,
7352 pbm_image_p,
7353 pbm_load,
7354 x_clear_image,
7355 NULL
7359 /* Return non-zero if OBJECT is a valid PBM image specification. */
7361 static int
7362 pbm_image_p (object)
7363 Lisp_Object object;
7365 struct image_keyword fmt[PBM_LAST];
7367 bcopy (pbm_format, fmt, sizeof fmt);
7369 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
7370 return 0;
7372 /* Must specify either :data or :file. */
7373 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7377 /* Scan a decimal number from *S and return it. Advance *S while
7378 reading the number. END is the end of the string. Value is -1 at
7379 end of input. */
7381 static int
7382 pbm_scan_number (s, end)
7383 unsigned char **s, *end;
7385 int c = 0, val = -1;
7387 while (*s < end)
7389 /* Skip white-space. */
7390 while (*s < end && (c = *(*s)++, isspace (c)))
7393 if (c == '#')
7395 /* Skip comment to end of line. */
7396 while (*s < end && (c = *(*s)++, c != '\n'))
7399 else if (isdigit (c))
7401 /* Read decimal number. */
7402 val = c - '0';
7403 while (*s < end && (c = *(*s)++, isdigit (c)))
7404 val = 10 * val + c - '0';
7405 break;
7407 else
7408 break;
7411 return val;
7415 /* Load PBM image IMG for use on frame F. */
7417 static int
7418 pbm_load (f, img)
7419 struct frame *f;
7420 struct image *img;
7422 int raw_p, x, y;
7423 int width, height, max_color_idx = 0;
7424 XImage *ximg;
7425 Lisp_Object file, specified_file;
7426 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7427 struct gcpro gcpro1;
7428 unsigned char *contents = NULL;
7429 unsigned char *end, *p;
7430 int size;
7432 specified_file = image_spec_value (img->spec, QCfile, NULL);
7433 file = Qnil;
7434 GCPRO1 (file);
7436 if (STRINGP (specified_file))
7438 file = x_find_image_file (specified_file);
7439 if (!STRINGP (file))
7441 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7442 UNGCPRO;
7443 return 0;
7446 contents = slurp_file (SDATA (file), &size);
7447 if (contents == NULL)
7449 image_error ("Error reading `%s'", file, Qnil);
7450 UNGCPRO;
7451 return 0;
7454 p = contents;
7455 end = contents + size;
7457 else
7459 Lisp_Object data;
7460 data = image_spec_value (img->spec, QCdata, NULL);
7461 p = SDATA (data);
7462 end = p + SBYTES (data);
7465 /* Check magic number. */
7466 if (end - p < 2 || *p++ != 'P')
7468 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7469 error:
7470 xfree (contents);
7471 UNGCPRO;
7472 return 0;
7475 switch (*p++)
7477 case '1':
7478 raw_p = 0, type = PBM_MONO;
7479 break;
7481 case '2':
7482 raw_p = 0, type = PBM_GRAY;
7483 break;
7485 case '3':
7486 raw_p = 0, type = PBM_COLOR;
7487 break;
7489 case '4':
7490 raw_p = 1, type = PBM_MONO;
7491 break;
7493 case '5':
7494 raw_p = 1, type = PBM_GRAY;
7495 break;
7497 case '6':
7498 raw_p = 1, type = PBM_COLOR;
7499 break;
7501 default:
7502 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
7503 goto error;
7506 /* Read width, height, maximum color-component. Characters
7507 starting with `#' up to the end of a line are ignored. */
7508 width = pbm_scan_number (&p, end);
7509 height = pbm_scan_number (&p, end);
7511 if (type != PBM_MONO)
7513 max_color_idx = pbm_scan_number (&p, end);
7514 if (raw_p && max_color_idx > 255)
7515 max_color_idx = 255;
7518 if (width < 0
7519 || height < 0
7520 || (type != PBM_MONO && max_color_idx < 0))
7521 goto error;
7523 if (!x_create_x_image_and_pixmap (f, width, height, 0,
7524 &ximg, &img->pixmap))
7525 goto error;
7527 /* Initialize the color hash table. */
7528 init_color_table ();
7530 if (type == PBM_MONO)
7532 int c = 0, g;
7533 struct image_keyword fmt[PBM_LAST];
7534 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
7535 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
7537 /* Parse the image specification. */
7538 bcopy (pbm_format, fmt, sizeof fmt);
7539 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
7541 /* Get foreground and background colors, maybe allocate colors. */
7542 if (fmt[PBM_FOREGROUND].count
7543 && STRINGP (fmt[PBM_FOREGROUND].value))
7544 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
7545 if (fmt[PBM_BACKGROUND].count
7546 && STRINGP (fmt[PBM_BACKGROUND].value))
7548 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
7549 img->background = bg;
7550 img->background_valid = 1;
7553 for (y = 0; y < height; ++y)
7554 for (x = 0; x < width; ++x)
7556 if (raw_p)
7558 if ((x & 7) == 0)
7559 c = *p++;
7560 g = c & 0x80;
7561 c <<= 1;
7563 else
7564 g = pbm_scan_number (&p, end);
7566 XPutPixel (ximg, x, y, g ? fg : bg);
7569 else
7571 for (y = 0; y < height; ++y)
7572 for (x = 0; x < width; ++x)
7574 int r, g, b;
7576 if (type == PBM_GRAY)
7577 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
7578 else if (raw_p)
7580 r = *p++;
7581 g = *p++;
7582 b = *p++;
7584 else
7586 r = pbm_scan_number (&p, end);
7587 g = pbm_scan_number (&p, end);
7588 b = pbm_scan_number (&p, end);
7591 if (r < 0 || g < 0 || b < 0)
7593 xfree (ximg->data);
7594 ximg->data = NULL;
7595 XDestroyImage (ximg);
7596 image_error ("Invalid pixel value in image `%s'",
7597 img->spec, Qnil);
7598 goto error;
7601 /* RGB values are now in the range 0..max_color_idx.
7602 Scale this to the range 0..0xffff supported by X. */
7603 r = (double) r * 65535 / max_color_idx;
7604 g = (double) g * 65535 / max_color_idx;
7605 b = (double) b * 65535 / max_color_idx;
7606 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7610 /* Store in IMG->colors the colors allocated for the image, and
7611 free the color table. */
7612 img->colors = colors_in_color_table (&img->ncolors);
7613 free_color_table ();
7615 /* Maybe fill in the background field while we have ximg handy. */
7616 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
7617 IMAGE_BACKGROUND (img, f, ximg);
7619 /* Put the image into a pixmap. */
7620 x_put_x_image (f, ximg, img->pixmap, width, height);
7621 x_destroy_x_image (ximg);
7623 img->width = width;
7624 img->height = height;
7626 UNGCPRO;
7627 xfree (contents);
7628 return 1;
7633 /***********************************************************************
7635 ***********************************************************************/
7637 #if HAVE_PNG
7639 #if defined HAVE_LIBPNG_PNG_H
7640 # include <libpng/png.h>
7641 #else
7642 # include <png.h>
7643 #endif
7645 /* Function prototypes. */
7647 static int png_image_p P_ ((Lisp_Object object));
7648 static int png_load P_ ((struct frame *f, struct image *img));
7650 /* The symbol `png' identifying images of this type. */
7652 Lisp_Object Qpng;
7654 /* Indices of image specification fields in png_format, below. */
7656 enum png_keyword_index
7658 PNG_TYPE,
7659 PNG_DATA,
7660 PNG_FILE,
7661 PNG_ASCENT,
7662 PNG_MARGIN,
7663 PNG_RELIEF,
7664 PNG_ALGORITHM,
7665 PNG_HEURISTIC_MASK,
7666 PNG_MASK,
7667 PNG_BACKGROUND,
7668 PNG_LAST
7671 /* Vector of image_keyword structures describing the format
7672 of valid user-defined image specifications. */
7674 static struct image_keyword png_format[PNG_LAST] =
7676 {":type", IMAGE_SYMBOL_VALUE, 1},
7677 {":data", IMAGE_STRING_VALUE, 0},
7678 {":file", IMAGE_STRING_VALUE, 0},
7679 {":ascent", IMAGE_ASCENT_VALUE, 0},
7680 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
7681 {":relief", IMAGE_INTEGER_VALUE, 0},
7682 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7683 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7684 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7685 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
7688 /* Structure describing the image type `png'. */
7690 static struct image_type png_type =
7692 &Qpng,
7693 png_image_p,
7694 png_load,
7695 x_clear_image,
7696 NULL
7700 /* Return non-zero if OBJECT is a valid PNG image specification. */
7702 static int
7703 png_image_p (object)
7704 Lisp_Object object;
7706 struct image_keyword fmt[PNG_LAST];
7707 bcopy (png_format, fmt, sizeof fmt);
7709 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
7710 return 0;
7712 /* Must specify either the :data or :file keyword. */
7713 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
7717 /* Error and warning handlers installed when the PNG library
7718 is initialized. */
7720 static void
7721 my_png_error (png_ptr, msg)
7722 png_struct *png_ptr;
7723 char *msg;
7725 xassert (png_ptr != NULL);
7726 image_error ("PNG error: %s", build_string (msg), Qnil);
7727 longjmp (png_ptr->jmpbuf, 1);
7731 static void
7732 my_png_warning (png_ptr, msg)
7733 png_struct *png_ptr;
7734 char *msg;
7736 xassert (png_ptr != NULL);
7737 image_error ("PNG warning: %s", build_string (msg), Qnil);
7740 /* Memory source for PNG decoding. */
7742 struct png_memory_storage
7744 unsigned char *bytes; /* The data */
7745 size_t len; /* How big is it? */
7746 int index; /* Where are we? */
7750 /* Function set as reader function when reading PNG image from memory.
7751 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7752 bytes from the input to DATA. */
7754 static void
7755 png_read_from_memory (png_ptr, data, length)
7756 png_structp png_ptr;
7757 png_bytep data;
7758 png_size_t length;
7760 struct png_memory_storage *tbr
7761 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
7763 if (length > tbr->len - tbr->index)
7764 png_error (png_ptr, "Read error");
7766 bcopy (tbr->bytes + tbr->index, data, length);
7767 tbr->index = tbr->index + length;
7770 /* Load PNG image IMG for use on frame F. Value is non-zero if
7771 successful. */
7773 static int
7774 png_load (f, img)
7775 struct frame *f;
7776 struct image *img;
7778 Lisp_Object file, specified_file;
7779 Lisp_Object specified_data;
7780 int x, y, i;
7781 XImage *ximg, *mask_img = NULL;
7782 struct gcpro gcpro1;
7783 png_struct *png_ptr = NULL;
7784 png_info *info_ptr = NULL, *end_info = NULL;
7785 FILE *volatile fp = NULL;
7786 png_byte sig[8];
7787 png_byte * volatile pixels = NULL;
7788 png_byte ** volatile rows = NULL;
7789 png_uint_32 width, height;
7790 int bit_depth, color_type, interlace_type;
7791 png_byte channels;
7792 png_uint_32 row_bytes;
7793 int transparent_p;
7794 double screen_gamma;
7795 struct png_memory_storage tbr; /* Data to be read */
7797 /* Find out what file to load. */
7798 specified_file = image_spec_value (img->spec, QCfile, NULL);
7799 specified_data = image_spec_value (img->spec, QCdata, NULL);
7800 file = Qnil;
7801 GCPRO1 (file);
7803 if (NILP (specified_data))
7805 file = x_find_image_file (specified_file);
7806 if (!STRINGP (file))
7808 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7809 UNGCPRO;
7810 return 0;
7813 /* Open the image file. */
7814 fp = fopen (SDATA (file), "rb");
7815 if (!fp)
7817 image_error ("Cannot open image file `%s'", file, Qnil);
7818 UNGCPRO;
7819 fclose (fp);
7820 return 0;
7823 /* Check PNG signature. */
7824 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7825 || !png_check_sig (sig, sizeof sig))
7827 image_error ("Not a PNG file: `%s'", file, Qnil);
7828 UNGCPRO;
7829 fclose (fp);
7830 return 0;
7833 else
7835 /* Read from memory. */
7836 tbr.bytes = SDATA (specified_data);
7837 tbr.len = SBYTES (specified_data);
7838 tbr.index = 0;
7840 /* Check PNG signature. */
7841 if (tbr.len < sizeof sig
7842 || !png_check_sig (tbr.bytes, sizeof sig))
7844 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
7845 UNGCPRO;
7846 return 0;
7849 /* Need to skip past the signature. */
7850 tbr.bytes += sizeof (sig);
7853 /* Initialize read and info structs for PNG lib. */
7854 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7855 my_png_error, my_png_warning);
7856 if (!png_ptr)
7858 if (fp) fclose (fp);
7859 UNGCPRO;
7860 return 0;
7863 info_ptr = png_create_info_struct (png_ptr);
7864 if (!info_ptr)
7866 png_destroy_read_struct (&png_ptr, NULL, NULL);
7867 if (fp) fclose (fp);
7868 UNGCPRO;
7869 return 0;
7872 end_info = png_create_info_struct (png_ptr);
7873 if (!end_info)
7875 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
7876 if (fp) fclose (fp);
7877 UNGCPRO;
7878 return 0;
7881 /* Set error jump-back. We come back here when the PNG library
7882 detects an error. */
7883 if (setjmp (png_ptr->jmpbuf))
7885 error:
7886 if (png_ptr)
7887 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
7888 xfree (pixels);
7889 xfree (rows);
7890 if (fp) fclose (fp);
7891 UNGCPRO;
7892 return 0;
7895 /* Read image info. */
7896 if (!NILP (specified_data))
7897 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
7898 else
7899 png_init_io (png_ptr, fp);
7901 png_set_sig_bytes (png_ptr, sizeof sig);
7902 png_read_info (png_ptr, info_ptr);
7903 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
7904 &interlace_type, NULL, NULL);
7906 /* If image contains simply transparency data, we prefer to
7907 construct a clipping mask. */
7908 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
7909 transparent_p = 1;
7910 else
7911 transparent_p = 0;
7913 /* This function is easier to write if we only have to handle
7914 one data format: RGB or RGBA with 8 bits per channel. Let's
7915 transform other formats into that format. */
7917 /* Strip more than 8 bits per channel. */
7918 if (bit_depth == 16)
7919 png_set_strip_16 (png_ptr);
7921 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7922 if available. */
7923 png_set_expand (png_ptr);
7925 /* Convert grayscale images to RGB. */
7926 if (color_type == PNG_COLOR_TYPE_GRAY
7927 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
7928 png_set_gray_to_rgb (png_ptr);
7930 screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
7932 #if 0 /* Avoid double gamma correction for PNG images. */
7933 { /* Tell the PNG lib to handle gamma correction for us. */
7934 int intent;
7935 double image_gamma;
7936 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7937 if (png_get_sRGB (png_ptr, info_ptr, &intent))
7938 /* The libpng documentation says this is right in this case. */
7939 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7940 else
7941 #endif
7942 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
7943 /* Image contains gamma information. */
7944 png_set_gamma (png_ptr, screen_gamma, image_gamma);
7945 else
7946 /* Use the standard default for the image gamma. */
7947 png_set_gamma (png_ptr, screen_gamma, 0.45455);
7949 #endif /* if 0 */
7951 /* Handle alpha channel by combining the image with a background
7952 color. Do this only if a real alpha channel is supplied. For
7953 simple transparency, we prefer a clipping mask. */
7954 if (!transparent_p)
7956 png_color_16 *image_bg;
7957 Lisp_Object specified_bg
7958 = image_spec_value (img->spec, QCbackground, NULL);
7960 if (STRINGP (specified_bg))
7961 /* The user specified `:background', use that. */
7963 XColor color;
7964 if (x_defined_color (f, SDATA (specified_bg), &color, 0))
7966 png_color_16 user_bg;
7968 bzero (&user_bg, sizeof user_bg);
7969 user_bg.red = color.red;
7970 user_bg.green = color.green;
7971 user_bg.blue = color.blue;
7973 png_set_background (png_ptr, &user_bg,
7974 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
7977 else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
7978 /* Image contains a background color with which to
7979 combine the image. */
7980 png_set_background (png_ptr, image_bg,
7981 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
7982 else
7984 /* Image does not contain a background color with which
7985 to combine the image data via an alpha channel. Use
7986 the frame's background instead. */
7987 XColor color;
7988 Colormap cmap;
7989 png_color_16 frame_background;
7991 cmap = FRAME_X_COLORMAP (f);
7992 color.pixel = FRAME_BACKGROUND_PIXEL (f);
7993 x_query_color (f, &color);
7995 bzero (&frame_background, sizeof frame_background);
7996 frame_background.red = color.red;
7997 frame_background.green = color.green;
7998 frame_background.blue = color.blue;
8000 png_set_background (png_ptr, &frame_background,
8001 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8005 /* Update info structure. */
8006 png_read_update_info (png_ptr, info_ptr);
8008 /* Get number of channels. Valid values are 1 for grayscale images
8009 and images with a palette, 2 for grayscale images with transparency
8010 information (alpha channel), 3 for RGB images, and 4 for RGB
8011 images with alpha channel, i.e. RGBA. If conversions above were
8012 sufficient we should only have 3 or 4 channels here. */
8013 channels = png_get_channels (png_ptr, info_ptr);
8014 xassert (channels == 3 || channels == 4);
8016 /* Number of bytes needed for one row of the image. */
8017 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8019 /* Allocate memory for the image. */
8020 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8021 rows = (png_byte **) xmalloc (height * sizeof *rows);
8022 for (i = 0; i < height; ++i)
8023 rows[i] = pixels + i * row_bytes;
8025 /* Read the entire image. */
8026 png_read_image (png_ptr, rows);
8027 png_read_end (png_ptr, info_ptr);
8028 if (fp)
8030 fclose (fp);
8031 fp = NULL;
8034 /* Create the X image and pixmap. */
8035 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8036 &img->pixmap))
8037 goto error;
8039 /* Create an image and pixmap serving as mask if the PNG image
8040 contains an alpha channel. */
8041 if (channels == 4
8042 && !transparent_p
8043 && !x_create_x_image_and_pixmap (f, width, height, 1,
8044 &mask_img, &img->mask))
8046 x_destroy_x_image (ximg);
8047 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8048 img->pixmap = None;
8049 goto error;
8052 /* Fill the X image and mask from PNG data. */
8053 init_color_table ();
8055 for (y = 0; y < height; ++y)
8057 png_byte *p = rows[y];
8059 for (x = 0; x < width; ++x)
8061 unsigned r, g, b;
8063 r = *p++ << 8;
8064 g = *p++ << 8;
8065 b = *p++ << 8;
8066 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8068 /* An alpha channel, aka mask channel, associates variable
8069 transparency with an image. Where other image formats
8070 support binary transparency---fully transparent or fully
8071 opaque---PNG allows up to 254 levels of partial transparency.
8072 The PNG library implements partial transparency by combining
8073 the image with a specified background color.
8075 I'm not sure how to handle this here nicely: because the
8076 background on which the image is displayed may change, for
8077 real alpha channel support, it would be necessary to create
8078 a new image for each possible background.
8080 What I'm doing now is that a mask is created if we have
8081 boolean transparency information. Otherwise I'm using
8082 the frame's background color to combine the image with. */
8084 if (channels == 4)
8086 if (mask_img)
8087 XPutPixel (mask_img, x, y, *p > 0);
8088 ++p;
8093 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8094 /* Set IMG's background color from the PNG image, unless the user
8095 overrode it. */
8097 png_color_16 *bg;
8098 if (png_get_bKGD (png_ptr, info_ptr, &bg))
8100 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
8101 img->background_valid = 1;
8105 /* Remember colors allocated for this image. */
8106 img->colors = colors_in_color_table (&img->ncolors);
8107 free_color_table ();
8109 /* Clean up. */
8110 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8111 xfree (rows);
8112 xfree (pixels);
8114 img->width = width;
8115 img->height = height;
8117 /* Maybe fill in the background field while we have ximg handy. */
8118 IMAGE_BACKGROUND (img, f, ximg);
8120 /* Put the image into the pixmap, then free the X image and its buffer. */
8121 x_put_x_image (f, ximg, img->pixmap, width, height);
8122 x_destroy_x_image (ximg);
8124 /* Same for the mask. */
8125 if (mask_img)
8127 /* Fill in the background_transparent field while we have the mask
8128 handy. */
8129 image_background_transparent (img, f, mask_img);
8131 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8132 x_destroy_x_image (mask_img);
8135 UNGCPRO;
8136 return 1;
8139 #endif /* HAVE_PNG != 0 */
8143 /***********************************************************************
8144 JPEG
8145 ***********************************************************************/
8147 #if HAVE_JPEG
8149 /* Work around a warning about HAVE_STDLIB_H being redefined in
8150 jconfig.h. */
8151 #ifdef HAVE_STDLIB_H
8152 #define HAVE_STDLIB_H_1
8153 #undef HAVE_STDLIB_H
8154 #endif /* HAVE_STLIB_H */
8156 #include <jpeglib.h>
8157 #include <jerror.h>
8158 #include <setjmp.h>
8160 #ifdef HAVE_STLIB_H_1
8161 #define HAVE_STDLIB_H 1
8162 #endif
8164 static int jpeg_image_p P_ ((Lisp_Object object));
8165 static int jpeg_load P_ ((struct frame *f, struct image *img));
8167 /* The symbol `jpeg' identifying images of this type. */
8169 Lisp_Object Qjpeg;
8171 /* Indices of image specification fields in gs_format, below. */
8173 enum jpeg_keyword_index
8175 JPEG_TYPE,
8176 JPEG_DATA,
8177 JPEG_FILE,
8178 JPEG_ASCENT,
8179 JPEG_MARGIN,
8180 JPEG_RELIEF,
8181 JPEG_ALGORITHM,
8182 JPEG_HEURISTIC_MASK,
8183 JPEG_MASK,
8184 JPEG_BACKGROUND,
8185 JPEG_LAST
8188 /* Vector of image_keyword structures describing the format
8189 of valid user-defined image specifications. */
8191 static struct image_keyword jpeg_format[JPEG_LAST] =
8193 {":type", IMAGE_SYMBOL_VALUE, 1},
8194 {":data", IMAGE_STRING_VALUE, 0},
8195 {":file", IMAGE_STRING_VALUE, 0},
8196 {":ascent", IMAGE_ASCENT_VALUE, 0},
8197 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8198 {":relief", IMAGE_INTEGER_VALUE, 0},
8199 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8200 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8201 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8202 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8205 /* Structure describing the image type `jpeg'. */
8207 static struct image_type jpeg_type =
8209 &Qjpeg,
8210 jpeg_image_p,
8211 jpeg_load,
8212 x_clear_image,
8213 NULL
8217 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8219 static int
8220 jpeg_image_p (object)
8221 Lisp_Object object;
8223 struct image_keyword fmt[JPEG_LAST];
8225 bcopy (jpeg_format, fmt, sizeof fmt);
8227 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
8228 return 0;
8230 /* Must specify either the :data or :file keyword. */
8231 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8235 struct my_jpeg_error_mgr
8237 struct jpeg_error_mgr pub;
8238 jmp_buf setjmp_buffer;
8242 static void
8243 my_error_exit (cinfo)
8244 j_common_ptr cinfo;
8246 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8247 longjmp (mgr->setjmp_buffer, 1);
8251 /* Init source method for JPEG data source manager. Called by
8252 jpeg_read_header() before any data is actually read. See
8253 libjpeg.doc from the JPEG lib distribution. */
8255 static void
8256 our_init_source (cinfo)
8257 j_decompress_ptr cinfo;
8262 /* Fill input buffer method for JPEG data source manager. Called
8263 whenever more data is needed. We read the whole image in one step,
8264 so this only adds a fake end of input marker at the end. */
8266 static boolean
8267 our_fill_input_buffer (cinfo)
8268 j_decompress_ptr cinfo;
8270 /* Insert a fake EOI marker. */
8271 struct jpeg_source_mgr *src = cinfo->src;
8272 static JOCTET buffer[2];
8274 buffer[0] = (JOCTET) 0xFF;
8275 buffer[1] = (JOCTET) JPEG_EOI;
8277 src->next_input_byte = buffer;
8278 src->bytes_in_buffer = 2;
8279 return TRUE;
8283 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8284 is the JPEG data source manager. */
8286 static void
8287 our_skip_input_data (cinfo, num_bytes)
8288 j_decompress_ptr cinfo;
8289 long num_bytes;
8291 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8293 if (src)
8295 if (num_bytes > src->bytes_in_buffer)
8296 ERREXIT (cinfo, JERR_INPUT_EOF);
8298 src->bytes_in_buffer -= num_bytes;
8299 src->next_input_byte += num_bytes;
8304 /* Method to terminate data source. Called by
8305 jpeg_finish_decompress() after all data has been processed. */
8307 static void
8308 our_term_source (cinfo)
8309 j_decompress_ptr cinfo;
8314 /* Set up the JPEG lib for reading an image from DATA which contains
8315 LEN bytes. CINFO is the decompression info structure created for
8316 reading the image. */
8318 static void
8319 jpeg_memory_src (cinfo, data, len)
8320 j_decompress_ptr cinfo;
8321 JOCTET *data;
8322 unsigned int len;
8324 struct jpeg_source_mgr *src;
8326 if (cinfo->src == NULL)
8328 /* First time for this JPEG object? */
8329 cinfo->src = (struct jpeg_source_mgr *)
8330 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8331 sizeof (struct jpeg_source_mgr));
8332 src = (struct jpeg_source_mgr *) cinfo->src;
8333 src->next_input_byte = data;
8336 src = (struct jpeg_source_mgr *) cinfo->src;
8337 src->init_source = our_init_source;
8338 src->fill_input_buffer = our_fill_input_buffer;
8339 src->skip_input_data = our_skip_input_data;
8340 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8341 src->term_source = our_term_source;
8342 src->bytes_in_buffer = len;
8343 src->next_input_byte = data;
8347 /* Load image IMG for use on frame F. Patterned after example.c
8348 from the JPEG lib. */
8350 static int
8351 jpeg_load (f, img)
8352 struct frame *f;
8353 struct image *img;
8355 struct jpeg_decompress_struct cinfo;
8356 struct my_jpeg_error_mgr mgr;
8357 Lisp_Object file, specified_file;
8358 Lisp_Object specified_data;
8359 FILE * volatile fp = NULL;
8360 JSAMPARRAY buffer;
8361 int row_stride, x, y;
8362 XImage *ximg = NULL;
8363 int rc;
8364 unsigned long *colors;
8365 int width, height;
8366 struct gcpro gcpro1;
8368 /* Open the JPEG file. */
8369 specified_file = image_spec_value (img->spec, QCfile, NULL);
8370 specified_data = image_spec_value (img->spec, QCdata, NULL);
8371 file = Qnil;
8372 GCPRO1 (file);
8374 if (NILP (specified_data))
8376 file = x_find_image_file (specified_file);
8377 if (!STRINGP (file))
8379 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8380 UNGCPRO;
8381 return 0;
8384 fp = fopen (SDATA (file), "r");
8385 if (fp == NULL)
8387 image_error ("Cannot open `%s'", file, Qnil);
8388 UNGCPRO;
8389 return 0;
8393 /* Customize libjpeg's error handling to call my_error_exit when an
8394 error is detected. This function will perform a longjmp. */
8395 cinfo.err = jpeg_std_error (&mgr.pub);
8396 mgr.pub.error_exit = my_error_exit;
8398 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8400 if (rc == 1)
8402 /* Called from my_error_exit. Display a JPEG error. */
8403 char buffer[JMSG_LENGTH_MAX];
8404 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8405 image_error ("Error reading JPEG image `%s': %s", img->spec,
8406 build_string (buffer));
8409 /* Close the input file and destroy the JPEG object. */
8410 if (fp)
8411 fclose ((FILE *) fp);
8412 jpeg_destroy_decompress (&cinfo);
8414 /* If we already have an XImage, free that. */
8415 x_destroy_x_image (ximg);
8417 /* Free pixmap and colors. */
8418 x_clear_image (f, img);
8420 UNGCPRO;
8421 return 0;
8424 /* Create the JPEG decompression object. Let it read from fp.
8425 Read the JPEG image header. */
8426 jpeg_create_decompress (&cinfo);
8428 if (NILP (specified_data))
8429 jpeg_stdio_src (&cinfo, (FILE *) fp);
8430 else
8431 jpeg_memory_src (&cinfo, SDATA (specified_data),
8432 SBYTES (specified_data));
8434 jpeg_read_header (&cinfo, TRUE);
8436 /* Customize decompression so that color quantization will be used.
8437 Start decompression. */
8438 cinfo.quantize_colors = TRUE;
8439 jpeg_start_decompress (&cinfo);
8440 width = img->width = cinfo.output_width;
8441 height = img->height = cinfo.output_height;
8443 /* Create X image and pixmap. */
8444 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8445 longjmp (mgr.setjmp_buffer, 2);
8447 /* Allocate colors. When color quantization is used,
8448 cinfo.actual_number_of_colors has been set with the number of
8449 colors generated, and cinfo.colormap is a two-dimensional array
8450 of color indices in the range 0..cinfo.actual_number_of_colors.
8451 No more than 255 colors will be generated. */
8453 int i, ir, ig, ib;
8455 if (cinfo.out_color_components > 2)
8456 ir = 0, ig = 1, ib = 2;
8457 else if (cinfo.out_color_components > 1)
8458 ir = 0, ig = 1, ib = 0;
8459 else
8460 ir = 0, ig = 0, ib = 0;
8462 /* Use the color table mechanism because it handles colors that
8463 cannot be allocated nicely. Such colors will be replaced with
8464 a default color, and we don't have to care about which colors
8465 can be freed safely, and which can't. */
8466 init_color_table ();
8467 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8468 * sizeof *colors);
8470 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8472 /* Multiply RGB values with 255 because X expects RGB values
8473 in the range 0..0xffff. */
8474 int r = cinfo.colormap[ir][i] << 8;
8475 int g = cinfo.colormap[ig][i] << 8;
8476 int b = cinfo.colormap[ib][i] << 8;
8477 colors[i] = lookup_rgb_color (f, r, g, b);
8480 /* Remember those colors actually allocated. */
8481 img->colors = colors_in_color_table (&img->ncolors);
8482 free_color_table ();
8485 /* Read pixels. */
8486 row_stride = width * cinfo.output_components;
8487 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8488 row_stride, 1);
8489 for (y = 0; y < height; ++y)
8491 jpeg_read_scanlines (&cinfo, buffer, 1);
8492 for (x = 0; x < cinfo.output_width; ++x)
8493 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8496 /* Clean up. */
8497 jpeg_finish_decompress (&cinfo);
8498 jpeg_destroy_decompress (&cinfo);
8499 if (fp)
8500 fclose ((FILE *) fp);
8502 /* Maybe fill in the background field while we have ximg handy. */
8503 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8504 IMAGE_BACKGROUND (img, f, ximg);
8506 /* Put the image into the pixmap. */
8507 x_put_x_image (f, ximg, img->pixmap, width, height);
8508 x_destroy_x_image (ximg);
8509 UNGCPRO;
8510 return 1;
8513 #endif /* HAVE_JPEG */
8517 /***********************************************************************
8518 TIFF
8519 ***********************************************************************/
8521 #if HAVE_TIFF
8523 #include <tiffio.h>
8525 static int tiff_image_p P_ ((Lisp_Object object));
8526 static int tiff_load P_ ((struct frame *f, struct image *img));
8528 /* The symbol `tiff' identifying images of this type. */
8530 Lisp_Object Qtiff;
8532 /* Indices of image specification fields in tiff_format, below. */
8534 enum tiff_keyword_index
8536 TIFF_TYPE,
8537 TIFF_DATA,
8538 TIFF_FILE,
8539 TIFF_ASCENT,
8540 TIFF_MARGIN,
8541 TIFF_RELIEF,
8542 TIFF_ALGORITHM,
8543 TIFF_HEURISTIC_MASK,
8544 TIFF_MASK,
8545 TIFF_BACKGROUND,
8546 TIFF_LAST
8549 /* Vector of image_keyword structures describing the format
8550 of valid user-defined image specifications. */
8552 static struct image_keyword tiff_format[TIFF_LAST] =
8554 {":type", IMAGE_SYMBOL_VALUE, 1},
8555 {":data", IMAGE_STRING_VALUE, 0},
8556 {":file", IMAGE_STRING_VALUE, 0},
8557 {":ascent", IMAGE_ASCENT_VALUE, 0},
8558 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8559 {":relief", IMAGE_INTEGER_VALUE, 0},
8560 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8561 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8562 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8563 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8566 /* Structure describing the image type `tiff'. */
8568 static struct image_type tiff_type =
8570 &Qtiff,
8571 tiff_image_p,
8572 tiff_load,
8573 x_clear_image,
8574 NULL
8578 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8580 static int
8581 tiff_image_p (object)
8582 Lisp_Object object;
8584 struct image_keyword fmt[TIFF_LAST];
8585 bcopy (tiff_format, fmt, sizeof fmt);
8587 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
8588 return 0;
8590 /* Must specify either the :data or :file keyword. */
8591 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
8595 /* Reading from a memory buffer for TIFF images Based on the PNG
8596 memory source, but we have to provide a lot of extra functions.
8597 Blah.
8599 We really only need to implement read and seek, but I am not
8600 convinced that the TIFF library is smart enough not to destroy
8601 itself if we only hand it the function pointers we need to
8602 override. */
8604 typedef struct
8606 unsigned char *bytes;
8607 size_t len;
8608 int index;
8610 tiff_memory_source;
8613 static size_t
8614 tiff_read_from_memory (data, buf, size)
8615 thandle_t data;
8616 tdata_t buf;
8617 tsize_t size;
8619 tiff_memory_source *src = (tiff_memory_source *) data;
8621 if (size > src->len - src->index)
8622 return (size_t) -1;
8623 bcopy (src->bytes + src->index, buf, size);
8624 src->index += size;
8625 return size;
8629 static size_t
8630 tiff_write_from_memory (data, buf, size)
8631 thandle_t data;
8632 tdata_t buf;
8633 tsize_t size;
8635 return (size_t) -1;
8639 static toff_t
8640 tiff_seek_in_memory (data, off, whence)
8641 thandle_t data;
8642 toff_t off;
8643 int whence;
8645 tiff_memory_source *src = (tiff_memory_source *) data;
8646 int idx;
8648 switch (whence)
8650 case SEEK_SET: /* Go from beginning of source. */
8651 idx = off;
8652 break;
8654 case SEEK_END: /* Go from end of source. */
8655 idx = src->len + off;
8656 break;
8658 case SEEK_CUR: /* Go from current position. */
8659 idx = src->index + off;
8660 break;
8662 default: /* Invalid `whence'. */
8663 return -1;
8666 if (idx > src->len || idx < 0)
8667 return -1;
8669 src->index = idx;
8670 return src->index;
8674 static int
8675 tiff_close_memory (data)
8676 thandle_t data;
8678 /* NOOP */
8679 return 0;
8683 static int
8684 tiff_mmap_memory (data, pbase, psize)
8685 thandle_t data;
8686 tdata_t *pbase;
8687 toff_t *psize;
8689 /* It is already _IN_ memory. */
8690 return 0;
8694 static void
8695 tiff_unmap_memory (data, base, size)
8696 thandle_t data;
8697 tdata_t base;
8698 toff_t size;
8700 /* We don't need to do this. */
8704 static toff_t
8705 tiff_size_of_memory (data)
8706 thandle_t data;
8708 return ((tiff_memory_source *) data)->len;
8712 static void
8713 tiff_error_handler (title, format, ap)
8714 const char *title, *format;
8715 va_list ap;
8717 char buf[512];
8718 int len;
8720 len = sprintf (buf, "TIFF error: %s ", title);
8721 vsprintf (buf + len, format, ap);
8722 add_to_log (buf, Qnil, Qnil);
8726 static void
8727 tiff_warning_handler (title, format, ap)
8728 const char *title, *format;
8729 va_list ap;
8731 char buf[512];
8732 int len;
8734 len = sprintf (buf, "TIFF warning: %s ", title);
8735 vsprintf (buf + len, format, ap);
8736 add_to_log (buf, Qnil, Qnil);
8740 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8741 successful. */
8743 static int
8744 tiff_load (f, img)
8745 struct frame *f;
8746 struct image *img;
8748 Lisp_Object file, specified_file;
8749 Lisp_Object specified_data;
8750 TIFF *tiff;
8751 int width, height, x, y;
8752 uint32 *buf;
8753 int rc;
8754 XImage *ximg;
8755 struct gcpro gcpro1;
8756 tiff_memory_source memsrc;
8758 specified_file = image_spec_value (img->spec, QCfile, NULL);
8759 specified_data = image_spec_value (img->spec, QCdata, NULL);
8760 file = Qnil;
8761 GCPRO1 (file);
8763 TIFFSetErrorHandler (tiff_error_handler);
8764 TIFFSetWarningHandler (tiff_warning_handler);
8766 if (NILP (specified_data))
8768 /* Read from a file */
8769 file = x_find_image_file (specified_file);
8770 if (!STRINGP (file))
8772 image_error ("Cannot find image file `%s'", file, Qnil);
8773 UNGCPRO;
8774 return 0;
8777 /* Try to open the image file. */
8778 tiff = TIFFOpen (SDATA (file), "r");
8779 if (tiff == NULL)
8781 image_error ("Cannot open `%s'", file, Qnil);
8782 UNGCPRO;
8783 return 0;
8786 else
8788 /* Memory source! */
8789 memsrc.bytes = SDATA (specified_data);
8790 memsrc.len = SBYTES (specified_data);
8791 memsrc.index = 0;
8793 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
8794 (TIFFReadWriteProc) tiff_read_from_memory,
8795 (TIFFReadWriteProc) tiff_write_from_memory,
8796 tiff_seek_in_memory,
8797 tiff_close_memory,
8798 tiff_size_of_memory,
8799 tiff_mmap_memory,
8800 tiff_unmap_memory);
8802 if (!tiff)
8804 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
8805 UNGCPRO;
8806 return 0;
8810 /* Get width and height of the image, and allocate a raster buffer
8811 of width x height 32-bit values. */
8812 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8813 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8814 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8816 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8817 TIFFClose (tiff);
8818 if (!rc)
8820 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
8821 xfree (buf);
8822 UNGCPRO;
8823 return 0;
8826 /* Create the X image and pixmap. */
8827 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8829 xfree (buf);
8830 UNGCPRO;
8831 return 0;
8834 /* Initialize the color table. */
8835 init_color_table ();
8837 /* Process the pixel raster. Origin is in the lower-left corner. */
8838 for (y = 0; y < height; ++y)
8840 uint32 *row = buf + y * width;
8842 for (x = 0; x < width; ++x)
8844 uint32 abgr = row[x];
8845 int r = TIFFGetR (abgr) << 8;
8846 int g = TIFFGetG (abgr) << 8;
8847 int b = TIFFGetB (abgr) << 8;
8848 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8852 /* Remember the colors allocated for the image. Free the color table. */
8853 img->colors = colors_in_color_table (&img->ncolors);
8854 free_color_table ();
8856 img->width = width;
8857 img->height = height;
8859 /* Maybe fill in the background field while we have ximg handy. */
8860 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
8861 IMAGE_BACKGROUND (img, f, ximg);
8863 /* Put the image into the pixmap, then free the X image and its buffer. */
8864 x_put_x_image (f, ximg, img->pixmap, width, height);
8865 x_destroy_x_image (ximg);
8866 xfree (buf);
8868 UNGCPRO;
8869 return 1;
8872 #endif /* HAVE_TIFF != 0 */
8876 /***********************************************************************
8878 ***********************************************************************/
8880 #if HAVE_GIF
8882 #include <gif_lib.h>
8884 static int gif_image_p P_ ((Lisp_Object object));
8885 static int gif_load P_ ((struct frame *f, struct image *img));
8887 /* The symbol `gif' identifying images of this type. */
8889 Lisp_Object Qgif;
8891 /* Indices of image specification fields in gif_format, below. */
8893 enum gif_keyword_index
8895 GIF_TYPE,
8896 GIF_DATA,
8897 GIF_FILE,
8898 GIF_ASCENT,
8899 GIF_MARGIN,
8900 GIF_RELIEF,
8901 GIF_ALGORITHM,
8902 GIF_HEURISTIC_MASK,
8903 GIF_MASK,
8904 GIF_IMAGE,
8905 GIF_BACKGROUND,
8906 GIF_LAST
8909 /* Vector of image_keyword structures describing the format
8910 of valid user-defined image specifications. */
8912 static struct image_keyword gif_format[GIF_LAST] =
8914 {":type", IMAGE_SYMBOL_VALUE, 1},
8915 {":data", IMAGE_STRING_VALUE, 0},
8916 {":file", IMAGE_STRING_VALUE, 0},
8917 {":ascent", IMAGE_ASCENT_VALUE, 0},
8918 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
8919 {":relief", IMAGE_INTEGER_VALUE, 0},
8920 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8921 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8922 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8923 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8924 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
8927 /* Structure describing the image type `gif'. */
8929 static struct image_type gif_type =
8931 &Qgif,
8932 gif_image_p,
8933 gif_load,
8934 x_clear_image,
8935 NULL
8939 /* Return non-zero if OBJECT is a valid GIF image specification. */
8941 static int
8942 gif_image_p (object)
8943 Lisp_Object object;
8945 struct image_keyword fmt[GIF_LAST];
8946 bcopy (gif_format, fmt, sizeof fmt);
8948 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
8949 return 0;
8951 /* Must specify either the :data or :file keyword. */
8952 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
8956 /* Reading a GIF image from memory
8957 Based on the PNG memory stuff to a certain extent. */
8959 typedef struct
8961 unsigned char *bytes;
8962 size_t len;
8963 int index;
8965 gif_memory_source;
8968 /* Make the current memory source available to gif_read_from_memory.
8969 It's done this way because not all versions of libungif support
8970 a UserData field in the GifFileType structure. */
8971 static gif_memory_source *current_gif_memory_src;
8973 static int
8974 gif_read_from_memory (file, buf, len)
8975 GifFileType *file;
8976 GifByteType *buf;
8977 int len;
8979 gif_memory_source *src = current_gif_memory_src;
8981 if (len > src->len - src->index)
8982 return -1;
8984 bcopy (src->bytes + src->index, buf, len);
8985 src->index += len;
8986 return len;
8990 /* Load GIF image IMG for use on frame F. Value is non-zero if
8991 successful. */
8993 static int
8994 gif_load (f, img)
8995 struct frame *f;
8996 struct image *img;
8998 Lisp_Object file, specified_file;
8999 Lisp_Object specified_data;
9000 int rc, width, height, x, y, i;
9001 XImage *ximg;
9002 ColorMapObject *gif_color_map;
9003 unsigned long pixel_colors[256];
9004 GifFileType *gif;
9005 struct gcpro gcpro1;
9006 Lisp_Object image;
9007 int ino, image_left, image_top, image_width, image_height;
9008 gif_memory_source memsrc;
9009 unsigned char *raster;
9011 specified_file = image_spec_value (img->spec, QCfile, NULL);
9012 specified_data = image_spec_value (img->spec, QCdata, NULL);
9013 file = Qnil;
9014 GCPRO1 (file);
9016 if (NILP (specified_data))
9018 file = x_find_image_file (specified_file);
9019 if (!STRINGP (file))
9021 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9022 UNGCPRO;
9023 return 0;
9026 /* Open the GIF file. */
9027 gif = DGifOpenFileName (SDATA (file));
9028 if (gif == NULL)
9030 image_error ("Cannot open `%s'", file, Qnil);
9031 UNGCPRO;
9032 return 0;
9035 else
9037 /* Read from memory! */
9038 current_gif_memory_src = &memsrc;
9039 memsrc.bytes = SDATA (specified_data);
9040 memsrc.len = SBYTES (specified_data);
9041 memsrc.index = 0;
9043 gif = DGifOpen (&memsrc, gif_read_from_memory);
9044 if (!gif)
9046 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9047 UNGCPRO;
9048 return 0;
9052 /* Read entire contents. */
9053 rc = DGifSlurp (gif);
9054 if (rc == GIF_ERROR)
9056 image_error ("Error reading `%s'", img->spec, Qnil);
9057 DGifCloseFile (gif);
9058 UNGCPRO;
9059 return 0;
9062 image = image_spec_value (img->spec, QCindex, NULL);
9063 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9064 if (ino >= gif->ImageCount)
9066 image_error ("Invalid image number `%s' in image `%s'",
9067 image, img->spec);
9068 DGifCloseFile (gif);
9069 UNGCPRO;
9070 return 0;
9073 width = img->width = max (gif->SWidth, gif->Image.Left + gif->Image.Width);
9074 height = img->height = max (gif->SHeight, gif->Image.Top + gif->Image.Height);
9076 /* Create the X image and pixmap. */
9077 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9079 DGifCloseFile (gif);
9080 UNGCPRO;
9081 return 0;
9084 /* Allocate colors. */
9085 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9086 if (!gif_color_map)
9087 gif_color_map = gif->SColorMap;
9088 init_color_table ();
9089 bzero (pixel_colors, sizeof pixel_colors);
9091 for (i = 0; i < gif_color_map->ColorCount; ++i)
9093 int r = gif_color_map->Colors[i].Red << 8;
9094 int g = gif_color_map->Colors[i].Green << 8;
9095 int b = gif_color_map->Colors[i].Blue << 8;
9096 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9099 img->colors = colors_in_color_table (&img->ncolors);
9100 free_color_table ();
9102 /* Clear the part of the screen image that are not covered by
9103 the image from the GIF file. Full animated GIF support
9104 requires more than can be done here (see the gif89 spec,
9105 disposal methods). Let's simply assume that the part
9106 not covered by a sub-image is in the frame's background color. */
9107 image_top = gif->SavedImages[ino].ImageDesc.Top;
9108 image_left = gif->SavedImages[ino].ImageDesc.Left;
9109 image_width = gif->SavedImages[ino].ImageDesc.Width;
9110 image_height = gif->SavedImages[ino].ImageDesc.Height;
9112 for (y = 0; y < image_top; ++y)
9113 for (x = 0; x < width; ++x)
9114 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9116 for (y = image_top + image_height; y < height; ++y)
9117 for (x = 0; x < width; ++x)
9118 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9120 for (y = image_top; y < image_top + image_height; ++y)
9122 for (x = 0; x < image_left; ++x)
9123 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9124 for (x = image_left + image_width; x < width; ++x)
9125 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9128 /* Read the GIF image into the X image. We use a local variable
9129 `raster' here because RasterBits below is a char *, and invites
9130 problems with bytes >= 0x80. */
9131 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9133 if (gif->SavedImages[ino].ImageDesc.Interlace)
9135 static int interlace_start[] = {0, 4, 2, 1};
9136 static int interlace_increment[] = {8, 8, 4, 2};
9137 int pass;
9138 int row = interlace_start[0];
9140 pass = 0;
9142 for (y = 0; y < image_height; y++)
9144 if (row >= image_height)
9146 row = interlace_start[++pass];
9147 while (row >= image_height)
9148 row = interlace_start[++pass];
9151 for (x = 0; x < image_width; x++)
9153 int i = raster[(y * image_width) + x];
9154 XPutPixel (ximg, x + image_left, row + image_top,
9155 pixel_colors[i]);
9158 row += interlace_increment[pass];
9161 else
9163 for (y = 0; y < image_height; ++y)
9164 for (x = 0; x < image_width; ++x)
9166 int i = raster[y * image_width + x];
9167 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9171 DGifCloseFile (gif);
9173 /* Maybe fill in the background field while we have ximg handy. */
9174 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
9175 IMAGE_BACKGROUND (img, f, ximg);
9177 /* Put the image into the pixmap, then free the X image and its buffer. */
9178 x_put_x_image (f, ximg, img->pixmap, width, height);
9179 x_destroy_x_image (ximg);
9181 UNGCPRO;
9182 return 1;
9185 #endif /* HAVE_GIF != 0 */
9189 /***********************************************************************
9190 Ghostscript
9191 ***********************************************************************/
9193 static int gs_image_p P_ ((Lisp_Object object));
9194 static int gs_load P_ ((struct frame *f, struct image *img));
9195 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9197 /* The symbol `postscript' identifying images of this type. */
9199 Lisp_Object Qpostscript;
9201 /* Keyword symbols. */
9203 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9205 /* Indices of image specification fields in gs_format, below. */
9207 enum gs_keyword_index
9209 GS_TYPE,
9210 GS_PT_WIDTH,
9211 GS_PT_HEIGHT,
9212 GS_FILE,
9213 GS_LOADER,
9214 GS_BOUNDING_BOX,
9215 GS_ASCENT,
9216 GS_MARGIN,
9217 GS_RELIEF,
9218 GS_ALGORITHM,
9219 GS_HEURISTIC_MASK,
9220 GS_MASK,
9221 GS_BACKGROUND,
9222 GS_LAST
9225 /* Vector of image_keyword structures describing the format
9226 of valid user-defined image specifications. */
9228 static struct image_keyword gs_format[GS_LAST] =
9230 {":type", IMAGE_SYMBOL_VALUE, 1},
9231 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9232 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9233 {":file", IMAGE_STRING_VALUE, 1},
9234 {":loader", IMAGE_FUNCTION_VALUE, 0},
9235 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9236 {":ascent", IMAGE_ASCENT_VALUE, 0},
9237 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
9238 {":relief", IMAGE_INTEGER_VALUE, 0},
9239 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9240 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9241 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9242 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
9245 /* Structure describing the image type `ghostscript'. */
9247 static struct image_type gs_type =
9249 &Qpostscript,
9250 gs_image_p,
9251 gs_load,
9252 gs_clear_image,
9253 NULL
9257 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9259 static void
9260 gs_clear_image (f, img)
9261 struct frame *f;
9262 struct image *img;
9264 /* IMG->data.ptr_val may contain a recorded colormap. */
9265 xfree (img->data.ptr_val);
9266 x_clear_image (f, img);
9270 /* Return non-zero if OBJECT is a valid Ghostscript image
9271 specification. */
9273 static int
9274 gs_image_p (object)
9275 Lisp_Object object;
9277 struct image_keyword fmt[GS_LAST];
9278 Lisp_Object tem;
9279 int i;
9281 bcopy (gs_format, fmt, sizeof fmt);
9283 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
9284 return 0;
9286 /* Bounding box must be a list or vector containing 4 integers. */
9287 tem = fmt[GS_BOUNDING_BOX].value;
9288 if (CONSP (tem))
9290 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9291 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9292 return 0;
9293 if (!NILP (tem))
9294 return 0;
9296 else if (VECTORP (tem))
9298 if (XVECTOR (tem)->size != 4)
9299 return 0;
9300 for (i = 0; i < 4; ++i)
9301 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9302 return 0;
9304 else
9305 return 0;
9307 return 1;
9311 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9312 if successful. */
9314 static int
9315 gs_load (f, img)
9316 struct frame *f;
9317 struct image *img;
9319 char buffer[100];
9320 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9321 struct gcpro gcpro1, gcpro2;
9322 Lisp_Object frame;
9323 double in_width, in_height;
9324 Lisp_Object pixel_colors = Qnil;
9326 /* Compute pixel size of pixmap needed from the given size in the
9327 image specification. Sizes in the specification are in pt. 1 pt
9328 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9329 info. */
9330 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9331 in_width = XFASTINT (pt_width) / 72.0;
9332 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9333 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9334 in_height = XFASTINT (pt_height) / 72.0;
9335 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9337 /* Create the pixmap. */
9338 xassert (img->pixmap == None);
9339 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9340 img->width, img->height,
9341 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9343 if (!img->pixmap)
9345 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9346 return 0;
9349 /* Call the loader to fill the pixmap. It returns a process object
9350 if successful. We do not record_unwind_protect here because
9351 other places in redisplay like calling window scroll functions
9352 don't either. Let the Lisp loader use `unwind-protect' instead. */
9353 GCPRO2 (window_and_pixmap_id, pixel_colors);
9355 sprintf (buffer, "%lu %lu",
9356 (unsigned long) FRAME_X_WINDOW (f),
9357 (unsigned long) img->pixmap);
9358 window_and_pixmap_id = build_string (buffer);
9360 sprintf (buffer, "%lu %lu",
9361 FRAME_FOREGROUND_PIXEL (f),
9362 FRAME_BACKGROUND_PIXEL (f));
9363 pixel_colors = build_string (buffer);
9365 XSETFRAME (frame, f);
9366 loader = image_spec_value (img->spec, QCloader, NULL);
9367 if (NILP (loader))
9368 loader = intern ("gs-load-image");
9370 img->data.lisp_val = call6 (loader, frame, img->spec,
9371 make_number (img->width),
9372 make_number (img->height),
9373 window_and_pixmap_id,
9374 pixel_colors);
9375 UNGCPRO;
9376 return PROCESSP (img->data.lisp_val);
9380 /* Kill the Ghostscript process that was started to fill PIXMAP on
9381 frame F. Called from XTread_socket when receiving an event
9382 telling Emacs that Ghostscript has finished drawing. */
9384 void
9385 x_kill_gs_process (pixmap, f)
9386 Pixmap pixmap;
9387 struct frame *f;
9389 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9390 int class, i;
9391 struct image *img;
9393 /* Find the image containing PIXMAP. */
9394 for (i = 0; i < c->used; ++i)
9395 if (c->images[i]->pixmap == pixmap)
9396 break;
9398 /* Should someone in between have cleared the image cache, for
9399 instance, give up. */
9400 if (i == c->used)
9401 return;
9403 /* Kill the GS process. We should have found PIXMAP in the image
9404 cache and its image should contain a process object. */
9405 img = c->images[i];
9406 xassert (PROCESSP (img->data.lisp_val));
9407 Fkill_process (img->data.lisp_val, Qnil);
9408 img->data.lisp_val = Qnil;
9410 /* On displays with a mutable colormap, figure out the colors
9411 allocated for the image by looking at the pixels of an XImage for
9412 img->pixmap. */
9413 class = FRAME_X_VISUAL (f)->class;
9414 if (class != StaticColor && class != StaticGray && class != TrueColor)
9416 XImage *ximg;
9418 BLOCK_INPUT;
9420 /* Try to get an XImage for img->pixmep. */
9421 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9422 0, 0, img->width, img->height, ~0, ZPixmap);
9423 if (ximg)
9425 int x, y;
9427 /* Initialize the color table. */
9428 init_color_table ();
9430 /* For each pixel of the image, look its color up in the
9431 color table. After having done so, the color table will
9432 contain an entry for each color used by the image. */
9433 for (y = 0; y < img->height; ++y)
9434 for (x = 0; x < img->width; ++x)
9436 unsigned long pixel = XGetPixel (ximg, x, y);
9437 lookup_pixel_color (f, pixel);
9440 /* Record colors in the image. Free color table and XImage. */
9441 img->colors = colors_in_color_table (&img->ncolors);
9442 free_color_table ();
9443 XDestroyImage (ximg);
9445 #if 0 /* This doesn't seem to be the case. If we free the colors
9446 here, we get a BadAccess later in x_clear_image when
9447 freeing the colors. */
9448 /* We have allocated colors once, but Ghostscript has also
9449 allocated colors on behalf of us. So, to get the
9450 reference counts right, free them once. */
9451 if (img->ncolors)
9452 x_free_colors (f, img->colors, img->ncolors);
9453 #endif
9455 else
9456 image_error ("Cannot get X image of `%s'; colors will not be freed",
9457 img->spec, Qnil);
9459 UNBLOCK_INPUT;
9462 /* Now that we have the pixmap, compute mask and transform the
9463 image if requested. */
9464 BLOCK_INPUT;
9465 postprocess_image (f, img);
9466 UNBLOCK_INPUT;
9471 /***********************************************************************
9472 Window properties
9473 ***********************************************************************/
9475 DEFUN ("x-change-window-property", Fx_change_window_property,
9476 Sx_change_window_property, 2, 6, 0,
9477 doc: /* Change window property PROP to VALUE on the X window of FRAME.
9478 PROP must be a string.
9479 VALUE may be a string or a list of conses, numbers and/or strings.
9480 If an element in the list is a string, it is converted to
9481 an Atom and the value of the Atom is used. If an element is a cons,
9482 it is converted to a 32 bit number where the car is the 16 top bits and the
9483 cdr is the lower 16 bits.
9484 FRAME nil or omitted means use the selected frame.
9485 If TYPE is given and non-nil, it is the name of the type of VALUE.
9486 If TYPE is not given or nil, the type is STRING.
9487 FORMAT gives the size in bits of each element if VALUE is a list.
9488 It must be one of 8, 16 or 32.
9489 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
9490 If OUTER_P is non-nil, the property is changed for the outer X window of
9491 FRAME. Default is to change on the edit X window.
9493 Value is VALUE. */)
9494 (prop, value, frame, type, format, outer_p)
9495 Lisp_Object prop, value, frame, type, format, outer_p;
9497 struct frame *f = check_x_frame (frame);
9498 Atom prop_atom;
9499 Atom target_type = XA_STRING;
9500 int element_format = 8;
9501 unsigned char *data;
9502 int nelements;
9503 Window w;
9505 CHECK_STRING (prop);
9507 if (! NILP (format))
9509 CHECK_NUMBER (format);
9510 element_format = XFASTINT (format);
9512 if (element_format != 8 && element_format != 16
9513 && element_format != 32)
9514 error ("FORMAT must be one of 8, 16 or 32");
9517 if (CONSP (value))
9519 nelements = x_check_property_data (value);
9520 if (nelements == -1)
9521 error ("Bad data in VALUE, must be number, string or cons");
9523 if (element_format == 8)
9524 data = (unsigned char *) xmalloc (nelements);
9525 else if (element_format == 16)
9526 data = (unsigned char *) xmalloc (nelements*2);
9527 else
9528 data = (unsigned char *) xmalloc (nelements*4);
9530 x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
9532 else
9534 CHECK_STRING (value);
9535 data = SDATA (value);
9536 nelements = SCHARS (value);
9539 BLOCK_INPUT;
9540 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9541 if (! NILP (type))
9543 CHECK_STRING (type);
9544 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
9547 if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
9548 else w = FRAME_X_WINDOW (f);
9550 XChangeProperty (FRAME_X_DISPLAY (f), w,
9551 prop_atom, target_type, element_format, PropModeReplace,
9552 data, nelements);
9554 if (CONSP (value)) xfree (data);
9556 /* Make sure the property is set when we return. */
9557 XFlush (FRAME_X_DISPLAY (f));
9558 UNBLOCK_INPUT;
9560 return value;
9564 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9565 Sx_delete_window_property, 1, 2, 0,
9566 doc: /* Remove window property PROP from X window of FRAME.
9567 FRAME nil or omitted means use the selected frame. Value is PROP. */)
9568 (prop, frame)
9569 Lisp_Object prop, frame;
9571 struct frame *f = check_x_frame (frame);
9572 Atom prop_atom;
9574 CHECK_STRING (prop);
9575 BLOCK_INPUT;
9576 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9577 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9579 /* Make sure the property is removed when we return. */
9580 XFlush (FRAME_X_DISPLAY (f));
9581 UNBLOCK_INPUT;
9583 return prop;
9587 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9588 1, 6, 0,
9589 doc: /* Value is the value of window property PROP on FRAME.
9590 If FRAME is nil or omitted, use the selected frame.
9591 If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
9592 is the name of the Atom that denotes the type expected.
9593 If SOURCE is non-nil, get the property on that window instead of from
9594 FRAME. The number 0 denotes the root window.
9595 If DELETE_P is non-nil, delete the property after retreiving it.
9596 If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
9598 Value is nil if FRAME hasn't a property with name PROP or if PROP has
9599 no value of TYPE. */)
9600 (prop, frame, type, source, delete_p, vector_ret_p)
9601 Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
9603 struct frame *f = check_x_frame (frame);
9604 Atom prop_atom;
9605 int rc;
9606 Lisp_Object prop_value = Qnil;
9607 char *tmp_data = NULL;
9608 Atom actual_type;
9609 Atom target_type = XA_STRING;
9610 int actual_format;
9611 unsigned long actual_size, bytes_remaining;
9612 Window target_window = FRAME_X_WINDOW (f);
9613 struct gcpro gcpro1;
9615 GCPRO1 (prop_value);
9616 CHECK_STRING (prop);
9618 if (! NILP (source))
9620 if (NUMBERP (source))
9622 if (FLOATP (source))
9623 target_window = (Window) XFLOAT (source);
9624 else
9625 target_window = XFASTINT (source);
9627 if (target_window == 0)
9628 target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
9630 else if (CONSP (source))
9631 target_window = cons_to_long (source);
9634 BLOCK_INPUT;
9635 if (STRINGP (type))
9637 if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
9638 target_type = AnyPropertyType;
9639 else
9640 target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
9643 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
9644 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
9645 prop_atom, 0, 0, False, target_type,
9646 &actual_type, &actual_format, &actual_size,
9647 &bytes_remaining, (unsigned char **) &tmp_data);
9648 if (rc == Success)
9650 int size = bytes_remaining;
9652 XFree (tmp_data);
9653 tmp_data = NULL;
9655 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
9656 prop_atom, 0, bytes_remaining,
9657 ! NILP (delete_p), target_type,
9658 &actual_type, &actual_format,
9659 &actual_size, &bytes_remaining,
9660 (unsigned char **) &tmp_data);
9661 if (rc == Success && tmp_data)
9663 if (NILP (vector_ret_p))
9664 prop_value = make_string (tmp_data, size);
9665 else
9666 prop_value = x_property_data_to_lisp (f,
9667 (unsigned char *) tmp_data,
9668 actual_type,
9669 actual_format,
9670 actual_size);
9673 if (tmp_data) XFree (tmp_data);
9676 UNBLOCK_INPUT;
9677 UNGCPRO;
9678 return prop_value;
9683 /***********************************************************************
9684 Busy cursor
9685 ***********************************************************************/
9687 /* If non-null, an asynchronous timer that, when it expires, displays
9688 an hourglass cursor on all frames. */
9690 static struct atimer *hourglass_atimer;
9692 /* Non-zero means an hourglass cursor is currently shown. */
9694 static int hourglass_shown_p;
9696 /* Number of seconds to wait before displaying an hourglass cursor. */
9698 static Lisp_Object Vhourglass_delay;
9700 /* Default number of seconds to wait before displaying an hourglass
9701 cursor. */
9703 #define DEFAULT_HOURGLASS_DELAY 1
9705 /* Function prototypes. */
9707 static void show_hourglass P_ ((struct atimer *));
9708 static void hide_hourglass P_ ((void));
9711 /* Cancel a currently active hourglass timer, and start a new one. */
9713 void
9714 start_hourglass ()
9716 EMACS_TIME delay;
9717 int secs, usecs = 0;
9719 cancel_hourglass ();
9721 if (INTEGERP (Vhourglass_delay)
9722 && XINT (Vhourglass_delay) > 0)
9723 secs = XFASTINT (Vhourglass_delay);
9724 else if (FLOATP (Vhourglass_delay)
9725 && XFLOAT_DATA (Vhourglass_delay) > 0)
9727 Lisp_Object tem;
9728 tem = Ftruncate (Vhourglass_delay, Qnil);
9729 secs = XFASTINT (tem);
9730 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
9732 else
9733 secs = DEFAULT_HOURGLASS_DELAY;
9735 EMACS_SET_SECS_USECS (delay, secs, usecs);
9736 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
9737 show_hourglass, NULL);
9741 /* Cancel the hourglass cursor timer if active, hide a busy cursor if
9742 shown. */
9744 void
9745 cancel_hourglass ()
9747 if (hourglass_atimer)
9749 cancel_atimer (hourglass_atimer);
9750 hourglass_atimer = NULL;
9753 if (hourglass_shown_p)
9754 hide_hourglass ();
9758 /* Timer function of hourglass_atimer. TIMER is equal to
9759 hourglass_atimer.
9761 Display an hourglass pointer on all frames by mapping the frames'
9762 hourglass_window. Set the hourglass_p flag in the frames'
9763 output_data.x structure to indicate that an hourglass cursor is
9764 shown on the frames. */
9766 static void
9767 show_hourglass (timer)
9768 struct atimer *timer;
9770 /* The timer implementation will cancel this timer automatically
9771 after this function has run. Set hourglass_atimer to null
9772 so that we know the timer doesn't have to be canceled. */
9773 hourglass_atimer = NULL;
9775 if (!hourglass_shown_p)
9777 Lisp_Object rest, frame;
9779 BLOCK_INPUT;
9781 FOR_EACH_FRAME (rest, frame)
9783 struct frame *f = XFRAME (frame);
9785 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
9787 Display *dpy = FRAME_X_DISPLAY (f);
9789 #ifdef USE_X_TOOLKIT
9790 if (f->output_data.x->widget)
9791 #else
9792 if (FRAME_OUTER_WINDOW (f))
9793 #endif
9795 f->output_data.x->hourglass_p = 1;
9797 if (!f->output_data.x->hourglass_window)
9799 unsigned long mask = CWCursor;
9800 XSetWindowAttributes attrs;
9802 attrs.cursor = f->output_data.x->hourglass_cursor;
9804 f->output_data.x->hourglass_window
9805 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
9806 0, 0, 32000, 32000, 0, 0,
9807 InputOnly,
9808 CopyFromParent,
9809 mask, &attrs);
9812 XMapRaised (dpy, f->output_data.x->hourglass_window);
9813 XFlush (dpy);
9818 hourglass_shown_p = 1;
9819 UNBLOCK_INPUT;
9824 /* Hide the hourglass pointer on all frames, if it is currently
9825 shown. */
9827 static void
9828 hide_hourglass ()
9830 if (hourglass_shown_p)
9832 Lisp_Object rest, frame;
9834 BLOCK_INPUT;
9835 FOR_EACH_FRAME (rest, frame)
9837 struct frame *f = XFRAME (frame);
9839 if (FRAME_X_P (f)
9840 /* Watch out for newly created frames. */
9841 && f->output_data.x->hourglass_window)
9843 XUnmapWindow (FRAME_X_DISPLAY (f),
9844 f->output_data.x->hourglass_window);
9845 /* Sync here because XTread_socket looks at the
9846 hourglass_p flag that is reset to zero below. */
9847 XSync (FRAME_X_DISPLAY (f), False);
9848 f->output_data.x->hourglass_p = 0;
9852 hourglass_shown_p = 0;
9853 UNBLOCK_INPUT;
9859 /***********************************************************************
9860 Tool tips
9861 ***********************************************************************/
9863 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9864 Lisp_Object, Lisp_Object));
9865 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
9866 Lisp_Object, int, int, int *, int *));
9868 /* The frame of a currently visible tooltip. */
9870 Lisp_Object tip_frame;
9872 /* If non-nil, a timer started that hides the last tooltip when it
9873 fires. */
9875 Lisp_Object tip_timer;
9876 Window tip_window;
9878 /* If non-nil, a vector of 3 elements containing the last args
9879 with which x-show-tip was called. See there. */
9881 Lisp_Object last_show_tip_args;
9883 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
9885 Lisp_Object Vx_max_tooltip_size;
9888 static Lisp_Object
9889 unwind_create_tip_frame (frame)
9890 Lisp_Object frame;
9892 Lisp_Object deleted;
9894 deleted = unwind_create_frame (frame);
9895 if (EQ (deleted, Qt))
9897 tip_window = None;
9898 tip_frame = Qnil;
9901 return deleted;
9905 /* Create a frame for a tooltip on the display described by DPYINFO.
9906 PARMS is a list of frame parameters. TEXT is the string to
9907 display in the tip frame. Value is the frame.
9909 Note that functions called here, esp. x_default_parameter can
9910 signal errors, for instance when a specified color name is
9911 undefined. We have to make sure that we're in a consistent state
9912 when this happens. */
9914 static Lisp_Object
9915 x_create_tip_frame (dpyinfo, parms, text)
9916 struct x_display_info *dpyinfo;
9917 Lisp_Object parms, text;
9919 struct frame *f;
9920 Lisp_Object frame, tem;
9921 Lisp_Object name;
9922 long window_prompting = 0;
9923 int width, height;
9924 int count = SPECPDL_INDEX ();
9925 struct gcpro gcpro1, gcpro2, gcpro3;
9926 struct kboard *kb;
9927 int face_change_count_before = face_change_count;
9928 Lisp_Object buffer;
9929 struct buffer *old_buffer;
9931 check_x ();
9933 /* Use this general default value to start with until we know if
9934 this frame has a specified name. */
9935 Vx_resource_name = Vinvocation_name;
9937 #ifdef MULTI_KBOARD
9938 kb = dpyinfo->kboard;
9939 #else
9940 kb = &the_only_kboard;
9941 #endif
9943 /* Get the name of the frame to use for resource lookup. */
9944 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9945 if (!STRINGP (name)
9946 && !EQ (name, Qunbound)
9947 && !NILP (name))
9948 error ("Invalid frame name--not a string or nil");
9949 Vx_resource_name = name;
9951 frame = Qnil;
9952 GCPRO3 (parms, name, frame);
9953 f = make_frame (1);
9954 XSETFRAME (frame, f);
9956 buffer = Fget_buffer_create (build_string (" *tip*"));
9957 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
9958 old_buffer = current_buffer;
9959 set_buffer_internal_1 (XBUFFER (buffer));
9960 current_buffer->truncate_lines = Qnil;
9961 Ferase_buffer ();
9962 Finsert (1, &text);
9963 set_buffer_internal_1 (old_buffer);
9965 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9966 record_unwind_protect (unwind_create_tip_frame, frame);
9968 /* By setting the output method, we're essentially saying that
9969 the frame is live, as per FRAME_LIVE_P. If we get a signal
9970 from this point on, x_destroy_window might screw up reference
9971 counts etc. */
9972 f->output_method = output_x_window;
9973 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9974 bzero (f->output_data.x, sizeof (struct x_output));
9975 f->output_data.x->icon_bitmap = -1;
9976 FRAME_FONTSET (f) = -1;
9977 f->output_data.x->scroll_bar_foreground_pixel = -1;
9978 f->output_data.x->scroll_bar_background_pixel = -1;
9979 #ifdef USE_TOOLKIT_SCROLL_BARS
9980 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
9981 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
9982 #endif /* USE_TOOLKIT_SCROLL_BARS */
9983 f->icon_name = Qnil;
9984 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9985 #if GLYPH_DEBUG
9986 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
9987 dpyinfo_refcount = dpyinfo->reference_count;
9988 #endif /* GLYPH_DEBUG */
9989 #ifdef MULTI_KBOARD
9990 FRAME_KBOARD (f) = kb;
9991 #endif
9992 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
9993 f->output_data.x->explicit_parent = 0;
9995 /* These colors will be set anyway later, but it's important
9996 to get the color reference counts right, so initialize them! */
9998 Lisp_Object black;
9999 struct gcpro gcpro1;
10001 black = build_string ("black");
10002 GCPRO1 (black);
10003 f->output_data.x->foreground_pixel
10004 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10005 f->output_data.x->background_pixel
10006 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10007 f->output_data.x->cursor_pixel
10008 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10009 f->output_data.x->cursor_foreground_pixel
10010 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10011 f->output_data.x->border_pixel
10012 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10013 f->output_data.x->mouse_pixel
10014 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10015 UNGCPRO;
10018 /* Set the name; the functions to which we pass f expect the name to
10019 be set. */
10020 if (EQ (name, Qunbound) || NILP (name))
10022 f->name = build_string (dpyinfo->x_id_name);
10023 f->explicit_name = 0;
10025 else
10027 f->name = name;
10028 f->explicit_name = 1;
10029 /* use the frame's title when getting resources for this frame. */
10030 specbind (Qx_resource_name, name);
10033 /* Extract the window parameters from the supplied values that are
10034 needed to determine window geometry. */
10036 Lisp_Object font;
10038 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10040 BLOCK_INPUT;
10041 /* First, try whatever font the caller has specified. */
10042 if (STRINGP (font))
10044 tem = Fquery_fontset (font, Qnil);
10045 if (STRINGP (tem))
10046 font = x_new_fontset (f, SDATA (tem));
10047 else
10048 font = x_new_font (f, SDATA (font));
10051 /* Try out a font which we hope has bold and italic variations. */
10052 if (!STRINGP (font))
10053 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10054 if (!STRINGP (font))
10055 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10056 if (! STRINGP (font))
10057 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10058 if (! STRINGP (font))
10059 /* This was formerly the first thing tried, but it finds too many fonts
10060 and takes too long. */
10061 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10062 /* If those didn't work, look for something which will at least work. */
10063 if (! STRINGP (font))
10064 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10065 UNBLOCK_INPUT;
10066 if (! STRINGP (font))
10067 font = build_string ("fixed");
10069 x_default_parameter (f, parms, Qfont, font,
10070 "font", "Font", RES_TYPE_STRING);
10073 x_default_parameter (f, parms, Qborder_width, make_number (2),
10074 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10076 /* This defaults to 2 in order to match xterm. We recognize either
10077 internalBorderWidth or internalBorder (which is what xterm calls
10078 it). */
10079 if (NILP (Fassq (Qinternal_border_width, parms)))
10081 Lisp_Object value;
10083 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10084 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10085 if (! EQ (value, Qunbound))
10086 parms = Fcons (Fcons (Qinternal_border_width, value),
10087 parms);
10090 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10091 "internalBorderWidth", "internalBorderWidth",
10092 RES_TYPE_NUMBER);
10094 /* Also do the stuff which must be set before the window exists. */
10095 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10096 "foreground", "Foreground", RES_TYPE_STRING);
10097 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10098 "background", "Background", RES_TYPE_STRING);
10099 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10100 "pointerColor", "Foreground", RES_TYPE_STRING);
10101 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10102 "cursorColor", "Foreground", RES_TYPE_STRING);
10103 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10104 "borderColor", "BorderColor", RES_TYPE_STRING);
10106 /* Init faces before x_default_parameter is called for scroll-bar
10107 parameters because that function calls x_set_scroll_bar_width,
10108 which calls change_frame_size, which calls Fset_window_buffer,
10109 which runs hooks, which call Fvertical_motion. At the end, we
10110 end up in init_iterator with a null face cache, which should not
10111 happen. */
10112 init_frame_faces (f);
10114 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10116 window_prompting = x_figure_window_size (f, parms, 0);
10119 XSetWindowAttributes attrs;
10120 unsigned long mask;
10122 BLOCK_INPUT;
10123 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10124 if (DoesSaveUnders (dpyinfo->screen))
10125 mask |= CWSaveUnder;
10127 /* Window managers look at the override-redirect flag to determine
10128 whether or net to give windows a decoration (Xlib spec, chapter
10129 3.2.8). */
10130 attrs.override_redirect = True;
10131 attrs.save_under = True;
10132 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10133 /* Arrange for getting MapNotify and UnmapNotify events. */
10134 attrs.event_mask = StructureNotifyMask;
10135 tip_window
10136 = FRAME_X_WINDOW (f)
10137 = XCreateWindow (FRAME_X_DISPLAY (f),
10138 FRAME_X_DISPLAY_INFO (f)->root_window,
10139 /* x, y, width, height */
10140 0, 0, 1, 1,
10141 /* Border. */
10143 CopyFromParent, InputOutput, CopyFromParent,
10144 mask, &attrs);
10145 UNBLOCK_INPUT;
10148 x_make_gc (f);
10150 x_default_parameter (f, parms, Qauto_raise, Qnil,
10151 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10152 x_default_parameter (f, parms, Qauto_lower, Qnil,
10153 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10154 x_default_parameter (f, parms, Qcursor_type, Qbox,
10155 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10157 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
10158 Change will not be effected unless different from the current
10159 FRAME_LINES (f). */
10160 width = FRAME_COLS (f);
10161 height = FRAME_LINES (f);
10162 SET_FRAME_COLS (f, 0);
10163 FRAME_LINES (f) = 0;
10164 change_frame_size (f, height, width, 1, 0, 0);
10166 /* Add `tooltip' frame parameter's default value. */
10167 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
10168 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
10169 Qnil));
10171 /* Set up faces after all frame parameters are known. This call
10172 also merges in face attributes specified for new frames.
10174 Frame parameters may be changed if .Xdefaults contains
10175 specifications for the default font. For example, if there is an
10176 `Emacs.default.attributeBackground: pink', the `background-color'
10177 attribute of the frame get's set, which let's the internal border
10178 of the tooltip frame appear in pink. Prevent this. */
10180 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10182 /* Set tip_frame here, so that */
10183 tip_frame = frame;
10184 call1 (Qface_set_after_frame_default, frame);
10186 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10187 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10188 Qnil));
10191 f->no_split = 1;
10193 UNGCPRO;
10195 /* It is now ok to make the frame official even if we get an error
10196 below. And the frame needs to be on Vframe_list or making it
10197 visible won't work. */
10198 Vframe_list = Fcons (frame, Vframe_list);
10200 /* Now that the frame is official, it counts as a reference to
10201 its display. */
10202 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10204 /* Setting attributes of faces of the tooltip frame from resources
10205 and similar will increment face_change_count, which leads to the
10206 clearing of all current matrices. Since this isn't necessary
10207 here, avoid it by resetting face_change_count to the value it
10208 had before we created the tip frame. */
10209 face_change_count = face_change_count_before;
10211 /* Discard the unwind_protect. */
10212 return unbind_to (count, frame);
10216 /* Compute where to display tip frame F. PARMS is the list of frame
10217 parameters for F. DX and DY are specified offsets from the current
10218 location of the mouse. WIDTH and HEIGHT are the width and height
10219 of the tooltip. Return coordinates relative to the root window of
10220 the display in *ROOT_X, and *ROOT_Y. */
10222 static void
10223 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
10224 struct frame *f;
10225 Lisp_Object parms, dx, dy;
10226 int width, height;
10227 int *root_x, *root_y;
10229 Lisp_Object left, top;
10230 int win_x, win_y;
10231 Window root, child;
10232 unsigned pmask;
10234 /* User-specified position? */
10235 left = Fcdr (Fassq (Qleft, parms));
10236 top = Fcdr (Fassq (Qtop, parms));
10238 /* Move the tooltip window where the mouse pointer is. Resize and
10239 show it. */
10240 if (!INTEGERP (left) || !INTEGERP (top))
10242 BLOCK_INPUT;
10243 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10244 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10245 UNBLOCK_INPUT;
10248 if (INTEGERP (top))
10249 *root_y = XINT (top);
10250 else if (*root_y + XINT (dy) - height < 0)
10251 *root_y -= XINT (dy);
10252 else
10254 *root_y -= height;
10255 *root_y += XINT (dy);
10258 if (INTEGERP (left))
10259 *root_x = XINT (left);
10260 else if (*root_x + XINT (dx) + width <= FRAME_X_DISPLAY_INFO (f)->width)
10261 /* It fits to the right of the pointer. */
10262 *root_x += XINT (dx);
10263 else if (width + XINT (dx) <= *root_x)
10264 /* It fits to the left of the pointer. */
10265 *root_x -= width + XINT (dx);
10266 else
10267 /* Put it left-justified on the screen--it ought to fit that way. */
10268 *root_x = 0;
10272 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
10273 doc: /* Show STRING in a "tooltip" window on frame FRAME.
10274 A tooltip window is a small X window displaying a string.
10276 FRAME nil or omitted means use the selected frame.
10278 PARMS is an optional list of frame parameters which can be used to
10279 change the tooltip's appearance.
10281 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10282 means use the default timeout of 5 seconds.
10284 If the list of frame parameters PARAMS contains a `left' parameters,
10285 the tooltip is displayed at that x-position. Otherwise it is
10286 displayed at the mouse position, with offset DX added (default is 5 if
10287 DX isn't specified). Likewise for the y-position; if a `top' frame
10288 parameter is specified, it determines the y-position of the tooltip
10289 window, otherwise it is displayed at the mouse position, with offset
10290 DY added (default is -10).
10292 A tooltip's maximum size is specified by `x-max-tooltip-size'.
10293 Text larger than the specified size is clipped. */)
10294 (string, frame, parms, timeout, dx, dy)
10295 Lisp_Object string, frame, parms, timeout, dx, dy;
10297 struct frame *f;
10298 struct window *w;
10299 int root_x, root_y;
10300 struct buffer *old_buffer;
10301 struct text_pos pos;
10302 int i, width, height;
10303 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10304 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10305 int count = SPECPDL_INDEX ();
10307 specbind (Qinhibit_redisplay, Qt);
10309 GCPRO4 (string, parms, frame, timeout);
10311 CHECK_STRING (string);
10312 f = check_x_frame (frame);
10313 if (NILP (timeout))
10314 timeout = make_number (5);
10315 else
10316 CHECK_NATNUM (timeout);
10318 if (NILP (dx))
10319 dx = make_number (5);
10320 else
10321 CHECK_NUMBER (dx);
10323 if (NILP (dy))
10324 dy = make_number (-10);
10325 else
10326 CHECK_NUMBER (dy);
10328 if (NILP (last_show_tip_args))
10329 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10331 if (!NILP (tip_frame))
10333 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10334 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10335 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10337 if (EQ (frame, last_frame)
10338 && !NILP (Fequal (last_string, string))
10339 && !NILP (Fequal (last_parms, parms)))
10341 struct frame *f = XFRAME (tip_frame);
10343 /* Only DX and DY have changed. */
10344 if (!NILP (tip_timer))
10346 Lisp_Object timer = tip_timer;
10347 tip_timer = Qnil;
10348 call1 (Qcancel_timer, timer);
10351 BLOCK_INPUT;
10352 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
10353 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
10354 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10355 root_x, root_y);
10356 UNBLOCK_INPUT;
10357 goto start_timer;
10361 /* Hide a previous tip, if any. */
10362 Fx_hide_tip ();
10364 ASET (last_show_tip_args, 0, string);
10365 ASET (last_show_tip_args, 1, frame);
10366 ASET (last_show_tip_args, 2, parms);
10368 /* Add default values to frame parameters. */
10369 if (NILP (Fassq (Qname, parms)))
10370 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10371 if (NILP (Fassq (Qinternal_border_width, parms)))
10372 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10373 if (NILP (Fassq (Qborder_width, parms)))
10374 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10375 if (NILP (Fassq (Qborder_color, parms)))
10376 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10377 if (NILP (Fassq (Qbackground_color, parms)))
10378 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10379 parms);
10381 /* Create a frame for the tooltip, and record it in the global
10382 variable tip_frame. */
10383 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
10384 f = XFRAME (frame);
10386 /* Set up the frame's root window. */
10387 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10388 w->left_col = w->top_line = make_number (0);
10390 if (CONSP (Vx_max_tooltip_size)
10391 && INTEGERP (XCAR (Vx_max_tooltip_size))
10392 && XINT (XCAR (Vx_max_tooltip_size)) > 0
10393 && INTEGERP (XCDR (Vx_max_tooltip_size))
10394 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
10396 w->total_cols = XCAR (Vx_max_tooltip_size);
10397 w->total_lines = XCDR (Vx_max_tooltip_size);
10399 else
10401 w->total_cols = make_number (80);
10402 w->total_lines = make_number (40);
10405 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
10406 adjust_glyphs (f);
10407 w->pseudo_window_p = 1;
10409 /* Display the tooltip text in a temporary buffer. */
10410 old_buffer = current_buffer;
10411 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
10412 current_buffer->truncate_lines = Qnil;
10413 clear_glyph_matrix (w->desired_matrix);
10414 clear_glyph_matrix (w->current_matrix);
10415 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10416 try_window (FRAME_ROOT_WINDOW (f), pos);
10418 /* Compute width and height of the tooltip. */
10419 width = height = 0;
10420 for (i = 0; i < w->desired_matrix->nrows; ++i)
10422 struct glyph_row *row = &w->desired_matrix->rows[i];
10423 struct glyph *last;
10424 int row_width;
10426 /* Stop at the first empty row at the end. */
10427 if (!row->enabled_p || !row->displays_text_p)
10428 break;
10430 /* Let the row go over the full width of the frame. */
10431 row->full_width_p = 1;
10433 /* There's a glyph at the end of rows that is used to place
10434 the cursor there. Don't include the width of this glyph. */
10435 if (row->used[TEXT_AREA])
10437 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10438 row_width = row->pixel_width - last->pixel_width;
10440 else
10441 row_width = row->pixel_width;
10443 height += row->height;
10444 width = max (width, row_width);
10447 /* Add the frame's internal border to the width and height the X
10448 window should have. */
10449 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10450 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10452 /* Move the tooltip window where the mouse pointer is. Resize and
10453 show it. */
10454 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
10456 BLOCK_INPUT;
10457 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10458 root_x, root_y, width, height);
10459 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10460 UNBLOCK_INPUT;
10462 /* Draw into the window. */
10463 w->must_be_updated_p = 1;
10464 update_single_window (w, 1);
10466 /* Restore original current buffer. */
10467 set_buffer_internal_1 (old_buffer);
10468 windows_or_buffers_changed = old_windows_or_buffers_changed;
10470 start_timer:
10471 /* Let the tip disappear after timeout seconds. */
10472 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10473 intern ("x-hide-tip"));
10475 UNGCPRO;
10476 return unbind_to (count, Qnil);
10480 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10481 doc: /* Hide the current tooltip window, if there is any.
10482 Value is t if tooltip was open, nil otherwise. */)
10485 int count;
10486 Lisp_Object deleted, frame, timer;
10487 struct gcpro gcpro1, gcpro2;
10489 /* Return quickly if nothing to do. */
10490 if (NILP (tip_timer) && NILP (tip_frame))
10491 return Qnil;
10493 frame = tip_frame;
10494 timer = tip_timer;
10495 GCPRO2 (frame, timer);
10496 tip_frame = tip_timer = deleted = Qnil;
10498 count = SPECPDL_INDEX ();
10499 specbind (Qinhibit_redisplay, Qt);
10500 specbind (Qinhibit_quit, Qt);
10502 if (!NILP (timer))
10503 call1 (Qcancel_timer, timer);
10505 if (FRAMEP (frame))
10507 Fdelete_frame (frame, Qnil);
10508 deleted = Qt;
10510 #ifdef USE_LUCID
10511 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10512 redisplay procedure is not called when a tip frame over menu
10513 items is unmapped. Redisplay the menu manually... */
10515 struct frame *f = SELECTED_FRAME ();
10516 Widget w = f->output_data.x->menubar_widget;
10517 extern void xlwmenu_redisplay P_ ((Widget));
10519 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
10520 && w != NULL)
10522 BLOCK_INPUT;
10523 xlwmenu_redisplay (w);
10524 UNBLOCK_INPUT;
10527 #endif /* USE_LUCID */
10530 UNGCPRO;
10531 return unbind_to (count, deleted);
10536 /***********************************************************************
10537 File selection dialog
10538 ***********************************************************************/
10540 #ifdef USE_MOTIF
10542 /* Callback for "OK" and "Cancel" on file selection dialog. */
10544 static void
10545 file_dialog_cb (widget, client_data, call_data)
10546 Widget widget;
10547 XtPointer call_data, client_data;
10549 int *result = (int *) client_data;
10550 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10551 *result = cb->reason;
10555 /* Callback for unmapping a file selection dialog. This is used to
10556 capture the case where a dialog is closed via a window manager's
10557 closer button, for example. Using a XmNdestroyCallback didn't work
10558 in this case. */
10560 static void
10561 file_dialog_unmap_cb (widget, client_data, call_data)
10562 Widget widget;
10563 XtPointer call_data, client_data;
10565 int *result = (int *) client_data;
10566 *result = XmCR_CANCEL;
10570 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10571 doc: /* Read file name, prompting with PROMPT in directory DIR.
10572 Use a file selection dialog.
10573 Select DEFAULT-FILENAME in the dialog's file selection box, if
10574 specified. Don't let the user enter a file name in the file
10575 selection dialog's entry field, if MUSTMATCH is non-nil. */)
10576 (prompt, dir, default_filename, mustmatch)
10577 Lisp_Object prompt, dir, default_filename, mustmatch;
10579 int result;
10580 struct frame *f = SELECTED_FRAME ();
10581 Lisp_Object file = Qnil;
10582 Widget dialog, text, list, help;
10583 Arg al[10];
10584 int ac = 0;
10585 extern XtAppContext Xt_app_con;
10586 XmString dir_xmstring, pattern_xmstring;
10587 int count = SPECPDL_INDEX ();
10588 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10590 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10591 CHECK_STRING (prompt);
10592 CHECK_STRING (dir);
10594 /* Prevent redisplay. */
10595 specbind (Qinhibit_redisplay, Qt);
10597 BLOCK_INPUT;
10599 /* Create the dialog with PROMPT as title, using DIR as initial
10600 directory and using "*" as pattern. */
10601 dir = Fexpand_file_name (dir, Qnil);
10602 dir_xmstring = XmStringCreateLocalized (SDATA (dir));
10603 pattern_xmstring = XmStringCreateLocalized ("*");
10605 XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
10606 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10607 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10608 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10609 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10610 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10611 "fsb", al, ac);
10612 XmStringFree (dir_xmstring);
10613 XmStringFree (pattern_xmstring);
10615 /* Add callbacks for OK and Cancel. */
10616 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10617 (XtPointer) &result);
10618 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10619 (XtPointer) &result);
10620 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
10621 (XtPointer) &result);
10623 /* Disable the help button since we can't display help. */
10624 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10625 XtSetSensitive (help, False);
10627 /* Mark OK button as default. */
10628 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10629 XmNshowAsDefault, True, NULL);
10631 /* If MUSTMATCH is non-nil, disable the file entry field of the
10632 dialog, so that the user must select a file from the files list
10633 box. We can't remove it because we wouldn't have a way to get at
10634 the result file name, then. */
10635 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10636 if (!NILP (mustmatch))
10638 Widget label;
10639 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10640 XtSetSensitive (text, False);
10641 XtSetSensitive (label, False);
10644 /* Manage the dialog, so that list boxes get filled. */
10645 XtManageChild (dialog);
10647 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10648 must include the path for this to work. */
10649 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10650 if (STRINGP (default_filename))
10652 XmString default_xmstring;
10653 int item_pos;
10655 default_xmstring
10656 = XmStringCreateLocalized (SDATA (default_filename));
10658 if (!XmListItemExists (list, default_xmstring))
10660 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10661 XmListAddItem (list, default_xmstring, 0);
10662 item_pos = 0;
10664 else
10665 item_pos = XmListItemPos (list, default_xmstring);
10666 XmStringFree (default_xmstring);
10668 /* Select the item and scroll it into view. */
10669 XmListSelectPos (list, item_pos, True);
10670 XmListSetPos (list, item_pos);
10673 /* Process events until the user presses Cancel or OK. */
10674 result = 0;
10675 while (result == 0)
10677 XEvent event;
10678 XtAppNextEvent (Xt_app_con, &event);
10679 (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
10682 /* Get the result. */
10683 if (result == XmCR_OK)
10685 XmString text;
10686 String data;
10688 XtVaGetValues (dialog, XmNtextString, &text, NULL);
10689 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10690 XmStringFree (text);
10691 file = build_string (data);
10692 XtFree (data);
10694 else
10695 file = Qnil;
10697 /* Clean up. */
10698 XtUnmanageChild (dialog);
10699 XtDestroyWidget (dialog);
10700 UNBLOCK_INPUT;
10701 UNGCPRO;
10703 /* Make "Cancel" equivalent to C-g. */
10704 if (NILP (file))
10705 Fsignal (Qquit, Qnil);
10707 return unbind_to (count, file);
10710 #endif /* USE_MOTIF */
10712 #ifdef USE_GTK
10714 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10715 "Read file name, prompting with PROMPT in directory DIR.\n\
10716 Use a file selection dialog.\n\
10717 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10718 specified. Don't let the user enter a file name in the file\n\
10719 selection dialog's entry field, if MUSTMATCH is non-nil.")
10720 (prompt, dir, default_filename, mustmatch)
10721 Lisp_Object prompt, dir, default_filename, mustmatch;
10723 FRAME_PTR f = SELECTED_FRAME ();
10724 char *fn;
10725 Lisp_Object file = Qnil;
10726 int count = specpdl_ptr - specpdl;
10727 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10728 char *cdef_file;
10730 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10731 CHECK_STRING (prompt);
10732 CHECK_STRING (dir);
10734 /* Prevent redisplay. */
10735 specbind (Qinhibit_redisplay, Qt);
10737 BLOCK_INPUT;
10739 if (STRINGP (default_filename))
10740 cdef_file = SDATA (default_filename);
10741 else
10742 cdef_file = SDATA (dir);
10744 fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
10746 if (fn)
10748 file = build_string (fn);
10749 xfree (fn);
10752 UNBLOCK_INPUT;
10753 UNGCPRO;
10755 /* Make "Cancel" equivalent to C-g. */
10756 if (NILP (file))
10757 Fsignal (Qquit, Qnil);
10759 return unbind_to (count, file);
10762 #endif /* USE_GTK */
10765 /***********************************************************************
10766 Keyboard
10767 ***********************************************************************/
10769 #ifdef HAVE_XKBGETKEYBOARD
10770 #include <X11/XKBlib.h>
10771 #include <X11/keysym.h>
10772 #endif
10774 DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
10775 Sx_backspace_delete_keys_p, 0, 1, 0,
10776 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
10777 FRAME nil means use the selected frame.
10778 Value is t if we know that both keys are present, and are mapped to the
10779 usual X keysyms. */)
10780 (frame)
10781 Lisp_Object frame;
10783 #ifdef HAVE_XKBGETKEYBOARD
10784 XkbDescPtr kb;
10785 struct frame *f = check_x_frame (frame);
10786 Display *dpy = FRAME_X_DISPLAY (f);
10787 Lisp_Object have_keys;
10788 int major, minor, op, event, error;
10790 BLOCK_INPUT;
10792 /* Check library version in case we're dynamically linked. */
10793 major = XkbMajorVersion;
10794 minor = XkbMinorVersion;
10795 if (!XkbLibraryVersion (&major, &minor))
10797 UNBLOCK_INPUT;
10798 return Qnil;
10801 /* Check that the server supports XKB. */
10802 major = XkbMajorVersion;
10803 minor = XkbMinorVersion;
10804 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
10806 UNBLOCK_INPUT;
10807 return Qnil;
10810 have_keys = Qnil;
10811 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
10812 if (kb)
10814 int delete_keycode = 0, backspace_keycode = 0, i;
10816 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
10818 for (i = kb->min_key_code;
10819 (i < kb->max_key_code
10820 && (delete_keycode == 0 || backspace_keycode == 0));
10821 ++i)
10823 /* The XKB symbolic key names can be seen most easily in
10824 the PS file generated by `xkbprint -label name
10825 $DISPLAY'. */
10826 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
10827 delete_keycode = i;
10828 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
10829 backspace_keycode = i;
10832 XkbFreeNames (kb, 0, True);
10835 XkbFreeClientMap (kb, 0, True);
10837 if (delete_keycode
10838 && backspace_keycode
10839 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
10840 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
10841 have_keys = Qt;
10843 UNBLOCK_INPUT;
10844 return have_keys;
10845 #else /* not HAVE_XKBGETKEYBOARD */
10846 return Qnil;
10847 #endif /* not HAVE_XKBGETKEYBOARD */
10852 /***********************************************************************
10853 Initialization
10854 ***********************************************************************/
10856 /* Keep this list in the same order as frame_parms in frame.c.
10857 Use 0 for unsupported frame parameters. */
10859 frame_parm_handler x_frame_parm_handlers[] =
10861 x_set_autoraise,
10862 x_set_autolower,
10863 x_set_background_color,
10864 x_set_border_color,
10865 x_set_border_width,
10866 x_set_cursor_color,
10867 x_set_cursor_type,
10868 x_set_font,
10869 x_set_foreground_color,
10870 x_set_icon_name,
10871 x_set_icon_type,
10872 x_set_internal_border_width,
10873 x_set_menu_bar_lines,
10874 x_set_mouse_color,
10875 x_explicitly_set_name,
10876 x_set_scroll_bar_width,
10877 x_set_title,
10878 x_set_unsplittable,
10879 x_set_vertical_scroll_bars,
10880 x_set_visibility,
10881 x_set_tool_bar_lines,
10882 x_set_scroll_bar_foreground,
10883 x_set_scroll_bar_background,
10884 x_set_screen_gamma,
10885 x_set_line_spacing,
10886 x_set_fringe_width,
10887 x_set_fringe_width,
10888 x_set_wait_for_wm,
10889 x_set_fullscreen,
10892 void
10893 syms_of_xfns ()
10895 /* This is zero if not using X windows. */
10896 x_in_use = 0;
10898 /* The section below is built by the lisp expression at the top of the file,
10899 just above where these variables are declared. */
10900 /*&&& init symbols here &&&*/
10901 Qnone = intern ("none");
10902 staticpro (&Qnone);
10903 Qsuppress_icon = intern ("suppress-icon");
10904 staticpro (&Qsuppress_icon);
10905 Qundefined_color = intern ("undefined-color");
10906 staticpro (&Qundefined_color);
10907 Qcenter = intern ("center");
10908 staticpro (&Qcenter);
10909 Qcompound_text = intern ("compound-text");
10910 staticpro (&Qcompound_text);
10911 Qcancel_timer = intern ("cancel-timer");
10912 staticpro (&Qcancel_timer);
10913 /* This is the end of symbol initialization. */
10915 /* Text property `display' should be nonsticky by default. */
10916 Vtext_property_default_nonsticky
10917 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10920 Qlaplace = intern ("laplace");
10921 staticpro (&Qlaplace);
10922 Qemboss = intern ("emboss");
10923 staticpro (&Qemboss);
10924 Qedge_detection = intern ("edge-detection");
10925 staticpro (&Qedge_detection);
10926 Qheuristic = intern ("heuristic");
10927 staticpro (&Qheuristic);
10928 QCmatrix = intern (":matrix");
10929 staticpro (&QCmatrix);
10930 QCcolor_adjustment = intern (":color-adjustment");
10931 staticpro (&QCcolor_adjustment);
10932 QCmask = intern (":mask");
10933 staticpro (&QCmask);
10935 Fput (Qundefined_color, Qerror_conditions,
10936 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10937 Fput (Qundefined_color, Qerror_message,
10938 build_string ("Undefined color"));
10940 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
10941 doc: /* Non-nil means always draw a cross over disabled images.
10942 Disabled images are those having an `:conversion disabled' property.
10943 A cross is always drawn on black & white displays. */);
10944 cross_disabled_images = 0;
10946 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10947 doc: /* List of directories to search for window system bitmap files. */);
10948 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10950 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10951 doc: /* The shape of the pointer when over text.
10952 Changing the value does not affect existing frames
10953 unless you set the mouse color. */);
10954 Vx_pointer_shape = Qnil;
10956 #if 0 /* This doesn't really do anything. */
10957 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10958 doc: /* The shape of the pointer when not over text.
10959 This variable takes effect when you create a new frame
10960 or when you set the mouse color. */);
10961 #endif
10962 Vx_nontext_pointer_shape = Qnil;
10964 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
10965 doc: /* The shape of the pointer when Emacs is busy.
10966 This variable takes effect when you create a new frame
10967 or when you set the mouse color. */);
10968 Vx_hourglass_pointer_shape = Qnil;
10970 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
10971 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
10972 display_hourglass_p = 1;
10974 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
10975 doc: /* *Seconds to wait before displaying an hourglass pointer.
10976 Value must be an integer or float. */);
10977 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
10979 #if 0 /* This doesn't really do anything. */
10980 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
10981 doc: /* The shape of the pointer when over the mode line.
10982 This variable takes effect when you create a new frame
10983 or when you set the mouse color. */);
10984 #endif
10985 Vx_mode_pointer_shape = Qnil;
10987 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10988 &Vx_sensitive_text_pointer_shape,
10989 doc: /* The shape of the pointer when over mouse-sensitive text.
10990 This variable takes effect when you create a new frame
10991 or when you set the mouse color. */);
10992 Vx_sensitive_text_pointer_shape = Qnil;
10994 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
10995 &Vx_window_horizontal_drag_shape,
10996 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
10997 This variable takes effect when you create a new frame
10998 or when you set the mouse color. */);
10999 Vx_window_horizontal_drag_shape = Qnil;
11001 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11002 doc: /* A string indicating the foreground color of the cursor box. */);
11003 Vx_cursor_fore_pixel = Qnil;
11005 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11006 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
11007 Text larger than this is clipped. */);
11008 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11010 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11011 doc: /* Non-nil if no X window manager is in use.
11012 Emacs doesn't try to figure this out; this is always nil
11013 unless you set it to something else. */);
11014 /* We don't have any way to find this out, so set it to nil
11015 and maybe the user would like to set it to t. */
11016 Vx_no_window_manager = Qnil;
11018 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11019 &Vx_pixel_size_width_font_regexp,
11020 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
11022 Since Emacs gets width of a font matching with this regexp from
11023 PIXEL_SIZE field of the name, font finding mechanism gets faster for
11024 such a font. This is especially effective for such large fonts as
11025 Chinese, Japanese, and Korean. */);
11026 Vx_pixel_size_width_font_regexp = Qnil;
11028 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11029 doc: /* Time after which cached images are removed from the cache.
11030 When an image has not been displayed this many seconds, remove it
11031 from the image cache. Value must be an integer or nil with nil
11032 meaning don't clear the cache. */);
11033 Vimage_cache_eviction_delay = make_number (30 * 60);
11035 #ifdef USE_X_TOOLKIT
11036 Fprovide (intern ("x-toolkit"), Qnil);
11037 #ifdef USE_MOTIF
11038 Fprovide (intern ("motif"), Qnil);
11040 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11041 doc: /* Version info for LessTif/Motif. */);
11042 Vmotif_version_string = build_string (XmVERSION_STRING);
11043 #endif /* USE_MOTIF */
11044 #endif /* USE_X_TOOLKIT */
11046 #ifdef USE_GTK
11047 Fprovide (intern ("gtk"), Qnil);
11049 DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string,
11050 doc: /* Version info for GTK+. */);
11052 char gtk_version[40];
11053 g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
11054 GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
11055 Vgtk_version_string = build_string (gtk_version);
11057 #endif /* USE_GTK */
11059 /* X window properties. */
11060 defsubr (&Sx_change_window_property);
11061 defsubr (&Sx_delete_window_property);
11062 defsubr (&Sx_window_property);
11064 defsubr (&Sxw_display_color_p);
11065 defsubr (&Sx_display_grayscale_p);
11066 defsubr (&Sxw_color_defined_p);
11067 defsubr (&Sxw_color_values);
11068 defsubr (&Sx_server_max_request_size);
11069 defsubr (&Sx_server_vendor);
11070 defsubr (&Sx_server_version);
11071 defsubr (&Sx_display_pixel_width);
11072 defsubr (&Sx_display_pixel_height);
11073 defsubr (&Sx_display_mm_width);
11074 defsubr (&Sx_display_mm_height);
11075 defsubr (&Sx_display_screens);
11076 defsubr (&Sx_display_planes);
11077 defsubr (&Sx_display_color_cells);
11078 defsubr (&Sx_display_visual_class);
11079 defsubr (&Sx_display_backing_store);
11080 defsubr (&Sx_display_save_under);
11081 defsubr (&Sx_create_frame);
11082 defsubr (&Sx_open_connection);
11083 defsubr (&Sx_close_connection);
11084 defsubr (&Sx_display_list);
11085 defsubr (&Sx_synchronize);
11086 defsubr (&Sx_focus_frame);
11087 defsubr (&Sx_backspace_delete_keys_p);
11089 /* Setting callback functions for fontset handler. */
11090 get_font_info_func = x_get_font_info;
11092 #if 0 /* This function pointer doesn't seem to be used anywhere.
11093 And the pointer assigned has the wrong type, anyway. */
11094 list_fonts_func = x_list_fonts;
11095 #endif
11097 load_font_func = x_load_font;
11098 find_ccl_program_func = x_find_ccl_program;
11099 query_font_func = x_query_font;
11100 set_frame_fontset_func = x_set_font;
11101 check_window_system_func = check_x;
11103 /* Images. */
11104 Qxbm = intern ("xbm");
11105 staticpro (&Qxbm);
11106 QCconversion = intern (":conversion");
11107 staticpro (&QCconversion);
11108 QCheuristic_mask = intern (":heuristic-mask");
11109 staticpro (&QCheuristic_mask);
11110 QCcolor_symbols = intern (":color-symbols");
11111 staticpro (&QCcolor_symbols);
11112 QCascent = intern (":ascent");
11113 staticpro (&QCascent);
11114 QCmargin = intern (":margin");
11115 staticpro (&QCmargin);
11116 QCrelief = intern (":relief");
11117 staticpro (&QCrelief);
11118 Qpostscript = intern ("postscript");
11119 staticpro (&Qpostscript);
11120 QCloader = intern (":loader");
11121 staticpro (&QCloader);
11122 QCbounding_box = intern (":bounding-box");
11123 staticpro (&QCbounding_box);
11124 QCpt_width = intern (":pt-width");
11125 staticpro (&QCpt_width);
11126 QCpt_height = intern (":pt-height");
11127 staticpro (&QCpt_height);
11128 QCindex = intern (":index");
11129 staticpro (&QCindex);
11130 Qpbm = intern ("pbm");
11131 staticpro (&Qpbm);
11133 #if HAVE_XPM
11134 Qxpm = intern ("xpm");
11135 staticpro (&Qxpm);
11136 #endif
11138 #if HAVE_JPEG
11139 Qjpeg = intern ("jpeg");
11140 staticpro (&Qjpeg);
11141 #endif
11143 #if HAVE_TIFF
11144 Qtiff = intern ("tiff");
11145 staticpro (&Qtiff);
11146 #endif
11148 #if HAVE_GIF
11149 Qgif = intern ("gif");
11150 staticpro (&Qgif);
11151 #endif
11153 #if HAVE_PNG
11154 Qpng = intern ("png");
11155 staticpro (&Qpng);
11156 #endif
11158 defsubr (&Sclear_image_cache);
11159 defsubr (&Simage_size);
11160 defsubr (&Simage_mask_p);
11162 hourglass_atimer = NULL;
11163 hourglass_shown_p = 0;
11165 defsubr (&Sx_show_tip);
11166 defsubr (&Sx_hide_tip);
11167 tip_timer = Qnil;
11168 staticpro (&tip_timer);
11169 tip_frame = Qnil;
11170 staticpro (&tip_frame);
11172 last_show_tip_args = Qnil;
11173 staticpro (&last_show_tip_args);
11175 #ifdef USE_MOTIF
11176 defsubr (&Sx_file_dialog);
11177 #endif
11181 void
11182 init_xfns ()
11184 image_types = NULL;
11185 Vimage_types = Qnil;
11187 define_image_type (&xbm_type);
11188 define_image_type (&gs_type);
11189 define_image_type (&pbm_type);
11191 #if HAVE_XPM
11192 define_image_type (&xpm_type);
11193 #endif
11195 #if HAVE_JPEG
11196 define_image_type (&jpeg_type);
11197 #endif
11199 #if HAVE_TIFF
11200 define_image_type (&tiff_type);
11201 #endif
11203 #if HAVE_GIF
11204 define_image_type (&gif_type);
11205 #endif
11207 #if HAVE_PNG
11208 define_image_type (&png_type);
11209 #endif
11212 #endif /* HAVE_X_WINDOWS */
11214 /* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288
11215 (do not change this comment) */