1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999
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)
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. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
44 #include "termhooks.h"
50 #include <sys/types.h>
54 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
55 #include "bitmaps/gray.xbm"
57 #include <X11/bitmaps/gray>
60 #include "[.bitmaps]gray.xbm"
64 #include <X11/Shell.h>
67 #include <X11/Xaw/Paned.h>
68 #include <X11/Xaw/Label.h>
69 #endif /* USE_MOTIF */
72 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
81 #include "../lwlib/lwlib.h"
85 #include <Xm/DialogS.h>
86 #include <Xm/FileSB.h>
89 /* Do the EDITRES protocol if running X11R5
90 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
92 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
94 extern void _XEditResCheckMessages ();
95 #endif /* R5 + Athena */
97 /* Unique id counter for widgets created by the Lucid Widget Library. */
99 extern LWLIB_ID widget_id_tick
;
102 /* This is part of a kludge--see lwlib/xlwmenu.c. */
103 extern XFontStruct
*xlwmenu_default_font
;
106 extern void free_frame_menubar ();
107 extern double atof ();
109 #endif /* USE_X_TOOLKIT */
111 #define min(a,b) ((a) < (b) ? (a) : (b))
112 #define max(a,b) ((a) > (b) ? (a) : (b))
115 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
117 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
120 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
121 it, and including `bitmaps/gray' more than once is a problem when
122 config.h defines `static' as an empty replacement string. */
124 int gray_bitmap_width
= gray_width
;
125 int gray_bitmap_height
= gray_height
;
126 unsigned char *gray_bitmap_bits
= gray_bits
;
128 /* The name we're using in resource queries. Most often "emacs". */
130 Lisp_Object Vx_resource_name
;
132 /* The application class we're using in resource queries.
135 Lisp_Object Vx_resource_class
;
137 /* Non-zero means we're allowed to display a busy cursor. */
139 int display_busy_cursor_p
;
141 /* The background and shape of the mouse pointer, and shape when not
142 over text or in the modeline. */
144 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
145 Lisp_Object Vx_busy_pointer_shape
;
147 /* The shape when over mouse-sensitive text. */
149 Lisp_Object Vx_sensitive_text_pointer_shape
;
151 /* Color of chars displayed in cursor box. */
153 Lisp_Object Vx_cursor_fore_pixel
;
155 /* Nonzero if using X. */
159 /* Non nil if no window manager is in use. */
161 Lisp_Object Vx_no_window_manager
;
163 /* Search path for bitmap files. */
165 Lisp_Object Vx_bitmap_file_path
;
167 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
169 Lisp_Object Vx_pixel_size_width_font_regexp
;
171 /* Evaluate this expression to rebuild the section of syms_of_xfns
172 that initializes and staticpros the symbols declared below. Note
173 that Emacs 18 has a bug that keeps C-x C-e from being able to
174 evaluate this expression.
177 ;; Accumulate a list of the symbols we want to initialize from the
178 ;; declarations at the top of the file.
179 (goto-char (point-min))
180 (search-forward "/\*&&& symbols declared here &&&*\/\n")
182 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
184 (cons (buffer-substring (match-beginning 1) (match-end 1))
187 (setq symbol-list (nreverse symbol-list))
188 ;; Delete the section of syms_of_... where we initialize the symbols.
189 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
190 (let ((start (point)))
191 (while (looking-at "^ Q")
193 (kill-region start (point)))
194 ;; Write a new symbol initialization section.
196 (insert (format " %s = intern (\"" (car symbol-list)))
197 (let ((start (point)))
198 (insert (substring (car symbol-list) 1))
199 (subst-char-in-region start (point) ?_ ?-))
200 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
201 (setq symbol-list (cdr symbol-list)))))
205 /*&&& symbols declared here &&&*/
206 Lisp_Object Qauto_raise
;
207 Lisp_Object Qauto_lower
;
209 Lisp_Object Qborder_color
;
210 Lisp_Object Qborder_width
;
212 Lisp_Object Qcursor_color
;
213 Lisp_Object Qcursor_type
;
214 Lisp_Object Qgeometry
;
215 Lisp_Object Qicon_left
;
216 Lisp_Object Qicon_top
;
217 Lisp_Object Qicon_type
;
218 Lisp_Object Qicon_name
;
219 Lisp_Object Qinternal_border_width
;
222 Lisp_Object Qmouse_color
;
224 Lisp_Object Qouter_window_id
;
225 Lisp_Object Qparent_id
;
226 Lisp_Object Qscroll_bar_width
;
227 Lisp_Object Qsuppress_icon
;
228 extern Lisp_Object Qtop
;
229 Lisp_Object Qundefined_color
;
230 Lisp_Object Qvertical_scroll_bars
;
231 Lisp_Object Qvisibility
;
232 Lisp_Object Qwindow_id
;
233 Lisp_Object Qx_frame_parameter
;
234 Lisp_Object Qx_resource_name
;
235 Lisp_Object Quser_position
;
236 Lisp_Object Quser_size
;
237 extern Lisp_Object Qdisplay
;
238 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
239 Lisp_Object Qscreen_gamma
;
241 /* The below are defined in frame.c. */
243 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
244 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
245 extern Lisp_Object Qtool_bar_lines
;
247 extern Lisp_Object Vwindow_system_version
;
249 Lisp_Object Qface_set_after_frame_default
;
252 /* Error if we are not connected to X. */
258 error ("X windows are not in use or not initialized");
261 /* Nonzero if we can use mouse menus.
262 You should not call this unless HAVE_MENUS is defined. */
270 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
271 and checking validity for X. */
274 check_x_frame (frame
)
280 frame
= selected_frame
;
281 CHECK_LIVE_FRAME (frame
, 0);
284 error ("Non-X frame used");
288 /* Let the user specify an X display with a frame.
289 nil stands for the selected frame--or, if that is not an X frame,
290 the first X display on the list. */
292 static struct x_display_info
*
293 check_x_display_info (frame
)
298 struct frame
*sf
= XFRAME (selected_frame
);
300 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
301 return FRAME_X_DISPLAY_INFO (sf
);
302 else if (x_display_list
!= 0)
303 return x_display_list
;
305 error ("X windows are not in use or not initialized");
307 else if (STRINGP (frame
))
308 return x_display_info_for_name (frame
);
313 CHECK_LIVE_FRAME (frame
, 0);
316 error ("Non-X frame used");
317 return FRAME_X_DISPLAY_INFO (f
);
322 /* Return the Emacs frame-object corresponding to an X window.
323 It could be the frame's main window or an icon window. */
325 /* This function can be called during GC, so use GC_xxx type test macros. */
328 x_window_to_frame (dpyinfo
, wdesc
)
329 struct x_display_info
*dpyinfo
;
332 Lisp_Object tail
, frame
;
335 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
338 if (!GC_FRAMEP (frame
))
341 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
343 if (f
->output_data
.x
->busy_window
== wdesc
)
346 if ((f
->output_data
.x
->edit_widget
347 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
348 /* A tooltip frame? */
349 || (!f
->output_data
.x
->edit_widget
350 && FRAME_X_WINDOW (f
) == wdesc
)
351 || f
->output_data
.x
->icon_desc
== wdesc
)
353 #else /* not USE_X_TOOLKIT */
354 if (FRAME_X_WINDOW (f
) == wdesc
355 || f
->output_data
.x
->icon_desc
== wdesc
)
357 #endif /* not USE_X_TOOLKIT */
363 /* Like x_window_to_frame but also compares the window with the widget's
367 x_any_window_to_frame (dpyinfo
, wdesc
)
368 struct x_display_info
*dpyinfo
;
371 Lisp_Object tail
, frame
;
372 struct frame
*f
, *found
;
376 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
379 if (!GC_FRAMEP (frame
))
383 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
385 /* This frame matches if the window is any of its widgets. */
386 x
= f
->output_data
.x
;
387 if (x
->busy_window
== wdesc
)
391 if (wdesc
== XtWindow (x
->widget
)
392 || wdesc
== XtWindow (x
->column_widget
)
393 || wdesc
== XtWindow (x
->edit_widget
))
395 /* Match if the window is this frame's menubar. */
396 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
399 else if (FRAME_X_WINDOW (f
) == wdesc
)
400 /* A tooltip frame. */
408 /* Likewise, but exclude the menu bar widget. */
411 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
412 struct x_display_info
*dpyinfo
;
415 Lisp_Object tail
, frame
;
419 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
422 if (!GC_FRAMEP (frame
))
425 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
427 x
= f
->output_data
.x
;
428 /* This frame matches if the window is any of its widgets. */
429 if (x
->busy_window
== wdesc
)
433 if (wdesc
== XtWindow (x
->widget
)
434 || wdesc
== XtWindow (x
->column_widget
)
435 || wdesc
== XtWindow (x
->edit_widget
))
438 else if (FRAME_X_WINDOW (f
) == wdesc
)
439 /* A tooltip frame. */
445 /* Likewise, but consider only the menu bar widget. */
448 x_menubar_window_to_frame (dpyinfo
, wdesc
)
449 struct x_display_info
*dpyinfo
;
452 Lisp_Object tail
, frame
;
456 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
459 if (!GC_FRAMEP (frame
))
462 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
464 x
= f
->output_data
.x
;
465 /* Match if the window is this frame's menubar. */
466 if (x
->menubar_widget
467 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
473 /* Return the frame whose principal (outermost) window is WDESC.
474 If WDESC is some other (smaller) window, we return 0. */
477 x_top_window_to_frame (dpyinfo
, wdesc
)
478 struct x_display_info
*dpyinfo
;
481 Lisp_Object tail
, frame
;
485 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
488 if (!GC_FRAMEP (frame
))
491 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
493 x
= f
->output_data
.x
;
497 /* This frame matches if the window is its topmost widget. */
498 if (wdesc
== XtWindow (x
->widget
))
500 #if 0 /* I don't know why it did this,
501 but it seems logically wrong,
502 and it causes trouble for MapNotify events. */
503 /* Match if the window is this frame's menubar. */
504 if (x
->menubar_widget
505 && wdesc
== XtWindow (x
->menubar_widget
))
509 else if (FRAME_X_WINDOW (f
) == wdesc
)
515 #endif /* USE_X_TOOLKIT */
519 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
520 id, which is just an int that this section returns. Bitmaps are
521 reference counted so they can be shared among frames.
523 Bitmap indices are guaranteed to be > 0, so a negative number can
524 be used to indicate no bitmap.
526 If you use x_create_bitmap_from_data, then you must keep track of
527 the bitmaps yourself. That is, creating a bitmap from the same
528 data more than once will not be caught. */
531 /* Functions to access the contents of a bitmap, given an id. */
534 x_bitmap_height (f
, id
)
538 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
542 x_bitmap_width (f
, id
)
546 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
550 x_bitmap_pixmap (f
, id
)
554 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
558 /* Allocate a new bitmap record. Returns index of new record. */
561 x_allocate_bitmap_record (f
)
564 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
567 if (dpyinfo
->bitmaps
== NULL
)
569 dpyinfo
->bitmaps_size
= 10;
571 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
572 dpyinfo
->bitmaps_last
= 1;
576 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
577 return ++dpyinfo
->bitmaps_last
;
579 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
580 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
583 dpyinfo
->bitmaps_size
*= 2;
585 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
586 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
587 return ++dpyinfo
->bitmaps_last
;
590 /* Add one reference to the reference count of the bitmap with id ID. */
593 x_reference_bitmap (f
, id
)
597 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
600 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
603 x_create_bitmap_from_data (f
, bits
, width
, height
)
606 unsigned int width
, height
;
608 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
612 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
613 bits
, width
, height
);
618 id
= x_allocate_bitmap_record (f
);
619 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
620 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
621 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
622 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
623 dpyinfo
->bitmaps
[id
- 1].height
= height
;
624 dpyinfo
->bitmaps
[id
- 1].width
= width
;
629 /* Create bitmap from file FILE for frame F. */
632 x_create_bitmap_from_file (f
, file
)
636 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
637 unsigned int width
, height
;
639 int xhot
, yhot
, result
, id
;
644 /* Look for an existing bitmap with the same name. */
645 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
647 if (dpyinfo
->bitmaps
[id
].refcount
648 && dpyinfo
->bitmaps
[id
].file
649 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
651 ++dpyinfo
->bitmaps
[id
].refcount
;
656 /* Search bitmap-file-path for the file, if appropriate. */
657 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
660 /* XReadBitmapFile won't handle magic file names. */
665 filename
= (char *) XSTRING (found
)->data
;
667 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
668 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
669 if (result
!= BitmapSuccess
)
672 id
= x_allocate_bitmap_record (f
);
673 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
674 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
675 dpyinfo
->bitmaps
[id
- 1].file
676 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
677 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
678 dpyinfo
->bitmaps
[id
- 1].height
= height
;
679 dpyinfo
->bitmaps
[id
- 1].width
= width
;
680 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
685 /* Remove reference to bitmap with id number ID. */
688 x_destroy_bitmap (f
, id
)
692 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
696 --dpyinfo
->bitmaps
[id
- 1].refcount
;
697 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
700 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
701 if (dpyinfo
->bitmaps
[id
- 1].file
)
703 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
704 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
711 /* Free all the bitmaps for the display specified by DPYINFO. */
714 x_destroy_all_bitmaps (dpyinfo
)
715 struct x_display_info
*dpyinfo
;
718 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
719 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
721 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
722 if (dpyinfo
->bitmaps
[i
].file
)
723 xfree (dpyinfo
->bitmaps
[i
].file
);
725 dpyinfo
->bitmaps_last
= 0;
728 /* Connect the frame-parameter names for X frames
729 to the ways of passing the parameter values to the window system.
731 The name of a parameter, as a Lisp symbol,
732 has an `x-frame-parameter' property which is an integer in Lisp
733 that is an index in this table. */
735 struct x_frame_parm_table
738 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 static void x_create_im
P_ ((struct frame
*));
742 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
754 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
759 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
767 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
769 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
774 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
776 static struct x_frame_parm_table x_frame_parms
[] =
778 "auto-raise", x_set_autoraise
,
779 "auto-lower", x_set_autolower
,
780 "background-color", x_set_background_color
,
781 "border-color", x_set_border_color
,
782 "border-width", x_set_border_width
,
783 "cursor-color", x_set_cursor_color
,
784 "cursor-type", x_set_cursor_type
,
786 "foreground-color", x_set_foreground_color
,
787 "icon-name", x_set_icon_name
,
788 "icon-type", x_set_icon_type
,
789 "internal-border-width", x_set_internal_border_width
,
790 "menu-bar-lines", x_set_menu_bar_lines
,
791 "mouse-color", x_set_mouse_color
,
792 "name", x_explicitly_set_name
,
793 "scroll-bar-width", x_set_scroll_bar_width
,
794 "title", x_set_title
,
795 "unsplittable", x_set_unsplittable
,
796 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
797 "visibility", x_set_visibility
,
798 "tool-bar-lines", x_set_tool_bar_lines
,
799 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
800 "scroll-bar-background", x_set_scroll_bar_background
,
801 "screen-gamma", x_set_screen_gamma
804 /* Attach the `x-frame-parameter' properties to
805 the Lisp symbol names of parameters relevant to X. */
808 init_x_parm_symbols ()
812 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
813 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
817 /* Change the parameters of frame F as specified by ALIST.
818 If a parameter is not specially recognized, do nothing;
819 otherwise call the `x_set_...' function for that parameter. */
822 x_set_frame_parameters (f
, alist
)
828 /* If both of these parameters are present, it's more efficient to
829 set them both at once. So we wait until we've looked at the
830 entire list before we set them. */
834 Lisp_Object left
, top
;
836 /* Same with these. */
837 Lisp_Object icon_left
, icon_top
;
839 /* Record in these vectors all the parms specified. */
843 int left_no_change
= 0, top_no_change
= 0;
844 int icon_left_no_change
= 0, icon_top_no_change
= 0;
846 struct gcpro gcpro1
, gcpro2
;
849 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
852 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
853 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
855 /* Extract parm names and values into those vectors. */
858 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
863 parms
[i
] = Fcar (elt
);
864 values
[i
] = Fcdr (elt
);
867 /* TAIL and ALIST are not used again below here. */
870 GCPRO2 (*parms
, *values
);
874 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
875 because their values appear in VALUES and strings are not valid. */
876 top
= left
= Qunbound
;
877 icon_left
= icon_top
= Qunbound
;
879 /* Provide default values for HEIGHT and WIDTH. */
880 if (FRAME_NEW_WIDTH (f
))
881 width
= FRAME_NEW_WIDTH (f
);
883 width
= FRAME_WIDTH (f
);
885 if (FRAME_NEW_HEIGHT (f
))
886 height
= FRAME_NEW_HEIGHT (f
);
888 height
= FRAME_HEIGHT (f
);
890 /* Process foreground_color and background_color before anything else.
891 They are independent of other properties, but other properties (e.g.,
892 cursor_color) are dependent upon them. */
893 for (p
= 0; p
< i
; p
++)
895 Lisp_Object prop
, val
;
899 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
901 register Lisp_Object param_index
, old_value
;
903 param_index
= Fget (prop
, Qx_frame_parameter
);
904 old_value
= get_frame_param (f
, prop
);
905 store_frame_param (f
, prop
, val
);
906 if (NATNUMP (param_index
)
907 && (XFASTINT (param_index
)
908 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
909 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
913 /* Now process them in reverse of specified order. */
914 for (i
--; i
>= 0; i
--)
916 Lisp_Object prop
, val
;
921 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
922 width
= XFASTINT (val
);
923 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
924 height
= XFASTINT (val
);
925 else if (EQ (prop
, Qtop
))
927 else if (EQ (prop
, Qleft
))
929 else if (EQ (prop
, Qicon_top
))
931 else if (EQ (prop
, Qicon_left
))
933 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
934 /* Processed above. */
938 register Lisp_Object param_index
, old_value
;
940 param_index
= Fget (prop
, Qx_frame_parameter
);
941 old_value
= get_frame_param (f
, prop
);
942 store_frame_param (f
, prop
, val
);
943 if (NATNUMP (param_index
)
944 && (XFASTINT (param_index
)
945 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
946 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
950 /* Don't die if just one of these was set. */
951 if (EQ (left
, Qunbound
))
954 if (f
->output_data
.x
->left_pos
< 0)
955 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
957 XSETINT (left
, f
->output_data
.x
->left_pos
);
959 if (EQ (top
, Qunbound
))
962 if (f
->output_data
.x
->top_pos
< 0)
963 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
965 XSETINT (top
, f
->output_data
.x
->top_pos
);
968 /* If one of the icon positions was not set, preserve or default it. */
969 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
971 icon_left_no_change
= 1;
972 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
973 if (NILP (icon_left
))
974 XSETINT (icon_left
, 0);
976 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
978 icon_top_no_change
= 1;
979 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
981 XSETINT (icon_top
, 0);
984 /* Don't set these parameters unless they've been explicitly
985 specified. The window might be mapped or resized while we're in
986 this function, and we don't want to override that unless the lisp
987 code has asked for it.
989 Don't set these parameters unless they actually differ from the
990 window's current parameters; the window may not actually exist
995 check_frame_size (f
, &height
, &width
);
997 XSETFRAME (frame
, f
);
999 if (width
!= FRAME_WIDTH (f
)
1000 || height
!= FRAME_HEIGHT (f
)
1001 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1002 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1004 if ((!NILP (left
) || !NILP (top
))
1005 && ! (left_no_change
&& top_no_change
)
1006 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1007 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1012 /* Record the signs. */
1013 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1014 if (EQ (left
, Qminus
))
1015 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1016 else if (INTEGERP (left
))
1018 leftpos
= XINT (left
);
1020 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1022 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1023 && CONSP (XCDR (left
))
1024 && INTEGERP (XCAR (XCDR (left
))))
1026 leftpos
= - XINT (XCAR (XCDR (left
)));
1027 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1029 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1030 && CONSP (XCDR (left
))
1031 && INTEGERP (XCAR (XCDR (left
))))
1033 leftpos
= XINT (XCAR (XCDR (left
)));
1036 if (EQ (top
, Qminus
))
1037 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1038 else if (INTEGERP (top
))
1040 toppos
= XINT (top
);
1042 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1044 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1045 && CONSP (XCDR (top
))
1046 && INTEGERP (XCAR (XCDR (top
))))
1048 toppos
= - XINT (XCAR (XCDR (top
)));
1049 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1051 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1052 && CONSP (XCDR (top
))
1053 && INTEGERP (XCAR (XCDR (top
))))
1055 toppos
= XINT (XCAR (XCDR (top
)));
1059 /* Store the numeric value of the position. */
1060 f
->output_data
.x
->top_pos
= toppos
;
1061 f
->output_data
.x
->left_pos
= leftpos
;
1063 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1065 /* Actually set that position, and convert to absolute. */
1066 x_set_offset (f
, leftpos
, toppos
, -1);
1069 if ((!NILP (icon_left
) || !NILP (icon_top
))
1070 && ! (icon_left_no_change
&& icon_top_no_change
))
1071 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1077 /* Store the screen positions of frame F into XPTR and YPTR.
1078 These are the positions of the containing window manager window,
1079 not Emacs's own window. */
1082 x_real_positions (f
, xptr
, yptr
)
1089 /* This is pretty gross, but seems to be the easiest way out of
1090 the problem that arises when restarting window-managers. */
1092 #ifdef USE_X_TOOLKIT
1093 Window outer
= (f
->output_data
.x
->widget
1094 ? XtWindow (f
->output_data
.x
->widget
)
1095 : FRAME_X_WINDOW (f
));
1097 Window outer
= f
->output_data
.x
->window_desc
;
1099 Window tmp_root_window
;
1100 Window
*tmp_children
;
1105 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1106 Window outer_window
;
1108 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1109 &f
->output_data
.x
->parent_desc
,
1110 &tmp_children
, &tmp_nchildren
);
1111 XFree ((char *) tmp_children
);
1115 /* Find the position of the outside upper-left corner of
1116 the inner window, with respect to the outer window. */
1117 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1118 outer_window
= f
->output_data
.x
->parent_desc
;
1120 outer_window
= outer
;
1122 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1124 /* From-window, to-window. */
1126 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1128 /* From-position, to-position. */
1129 0, 0, &win_x
, &win_y
,
1134 /* It is possible for the window returned by the XQueryNotify
1135 to become invalid by the time we call XTranslateCoordinates.
1136 That can happen when you restart some window managers.
1137 If so, we get an error in XTranslateCoordinates.
1138 Detect that and try the whole thing over. */
1139 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1141 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1145 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1152 /* Insert a description of internally-recorded parameters of frame X
1153 into the parameter alist *ALISTPTR that is to be given to the user.
1154 Only parameters that are specific to the X window system
1155 and whose values are not correctly recorded in the frame's
1156 param_alist need to be considered here. */
1159 x_report_frame_params (f
, alistptr
)
1161 Lisp_Object
*alistptr
;
1166 /* Represent negative positions (off the top or left screen edge)
1167 in a way that Fmodify_frame_parameters will understand correctly. */
1168 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1169 if (f
->output_data
.x
->left_pos
>= 0)
1170 store_in_alist (alistptr
, Qleft
, tem
);
1172 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1174 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1175 if (f
->output_data
.x
->top_pos
>= 0)
1176 store_in_alist (alistptr
, Qtop
, tem
);
1178 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1180 store_in_alist (alistptr
, Qborder_width
,
1181 make_number (f
->output_data
.x
->border_width
));
1182 store_in_alist (alistptr
, Qinternal_border_width
,
1183 make_number (f
->output_data
.x
->internal_border_width
));
1184 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1185 store_in_alist (alistptr
, Qwindow_id
,
1186 build_string (buf
));
1187 #ifdef USE_X_TOOLKIT
1188 /* Tooltip frame may not have this widget. */
1189 if (f
->output_data
.x
->widget
)
1191 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1192 store_in_alist (alistptr
, Qouter_window_id
,
1193 build_string (buf
));
1194 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1195 FRAME_SAMPLE_VISIBILITY (f
);
1196 store_in_alist (alistptr
, Qvisibility
,
1197 (FRAME_VISIBLE_P (f
) ? Qt
1198 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1199 store_in_alist (alistptr
, Qdisplay
,
1200 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1202 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1205 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1206 store_in_alist (alistptr
, Qparent_id
, tem
);
1211 /* Gamma-correct COLOR on frame F. */
1214 gamma_correct (f
, color
)
1220 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1221 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1222 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1227 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1228 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1229 allocate the color. Value is zero if COLOR_NAME is invalid, or
1230 no color could be allocated. */
1233 x_defined_color (f
, color_name
, color
, alloc_p
)
1240 Display
*dpy
= FRAME_X_DISPLAY (f
);
1241 Colormap cmap
= FRAME_X_COLORMAP (f
);
1244 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1245 if (success_p
&& alloc_p
)
1246 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1253 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1254 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1255 Signal an error if color can't be allocated. */
1258 x_decode_color (f
, color_name
, mono_color
)
1260 Lisp_Object color_name
;
1265 CHECK_STRING (color_name
, 0);
1267 #if 0 /* Don't do this. It's wrong when we're not using the default
1268 colormap, it makes freeing difficult, and it's probably not
1269 an important optimization. */
1270 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1271 return BLACK_PIX_DEFAULT (f
);
1272 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1273 return WHITE_PIX_DEFAULT (f
);
1276 /* Return MONO_COLOR for monochrome frames. */
1277 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1280 /* x_defined_color is responsible for coping with failures
1281 by looking for a near-miss. */
1282 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1285 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1286 Fcons (color_name
, Qnil
)));
1291 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1292 the previous value of that parameter, NEW_VALUE is the new value. */
1295 x_set_screen_gamma (f
, new_value
, old_value
)
1297 Lisp_Object new_value
, old_value
;
1299 if (NILP (new_value
))
1301 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1302 /* The value 0.4545 is the normal viewing gamma. */
1303 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1305 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1306 Fcons (new_value
, Qnil
)));
1308 clear_face_cache (0);
1312 /* Functions called only from `x_set_frame_param'
1313 to set individual parameters.
1315 If FRAME_X_WINDOW (f) is 0,
1316 the frame is being created and its X-window does not exist yet.
1317 In that case, just record the parameter's new value
1318 in the standard place; do not attempt to change the window. */
1321 x_set_foreground_color (f
, arg
, oldval
)
1323 Lisp_Object arg
, oldval
;
1326 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1328 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1329 f
->output_data
.x
->foreground_pixel
= pixel
;
1331 if (FRAME_X_WINDOW (f
) != 0)
1334 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1335 f
->output_data
.x
->foreground_pixel
);
1336 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1337 f
->output_data
.x
->foreground_pixel
);
1339 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1340 if (FRAME_VISIBLE_P (f
))
1346 x_set_background_color (f
, arg
, oldval
)
1348 Lisp_Object arg
, oldval
;
1351 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1353 unload_color (f
, f
->output_data
.x
->background_pixel
);
1354 f
->output_data
.x
->background_pixel
= pixel
;
1356 if (FRAME_X_WINDOW (f
) != 0)
1359 /* The main frame area. */
1360 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1361 f
->output_data
.x
->background_pixel
);
1362 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1363 f
->output_data
.x
->background_pixel
);
1364 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1365 f
->output_data
.x
->background_pixel
);
1366 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1367 f
->output_data
.x
->background_pixel
);
1370 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1371 bar
= XSCROLL_BAR (bar
)->next
)
1372 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1373 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1374 f
->output_data
.x
->background_pixel
);
1378 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1380 if (FRAME_VISIBLE_P (f
))
1386 x_set_mouse_color (f
, arg
, oldval
)
1388 Lisp_Object arg
, oldval
;
1390 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1393 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1394 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1396 /* Don't let pointers be invisible. */
1397 if (mask_color
== pixel
1398 && mask_color
== f
->output_data
.x
->background_pixel
)
1399 pixel
= f
->output_data
.x
->foreground_pixel
;
1401 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1402 f
->output_data
.x
->mouse_pixel
= pixel
;
1406 /* It's not okay to crash if the user selects a screwy cursor. */
1407 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1409 if (!EQ (Qnil
, Vx_pointer_shape
))
1411 CHECK_NUMBER (Vx_pointer_shape
, 0);
1412 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1415 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1416 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1418 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1420 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1421 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1422 XINT (Vx_nontext_pointer_shape
));
1425 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1426 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1428 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1430 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1431 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1432 XINT (Vx_busy_pointer_shape
));
1435 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1436 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1438 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1439 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1441 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1442 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1443 XINT (Vx_mode_pointer_shape
));
1446 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1447 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1449 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1451 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1453 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1454 XINT (Vx_sensitive_text_pointer_shape
));
1457 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1459 /* Check and report errors with the above calls. */
1460 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1461 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1464 XColor fore_color
, back_color
;
1466 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1467 back_color
.pixel
= mask_color
;
1468 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1470 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1472 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1473 &fore_color
, &back_color
);
1474 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1475 &fore_color
, &back_color
);
1476 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1477 &fore_color
, &back_color
);
1478 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1479 &fore_color
, &back_color
);
1480 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1481 &fore_color
, &back_color
);
1484 if (FRAME_X_WINDOW (f
) != 0)
1485 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1487 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1488 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1489 f
->output_data
.x
->text_cursor
= cursor
;
1491 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1492 && f
->output_data
.x
->nontext_cursor
!= 0)
1493 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1494 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1496 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1497 && f
->output_data
.x
->busy_cursor
!= 0)
1498 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1499 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1501 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1502 && f
->output_data
.x
->modeline_cursor
!= 0)
1503 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1504 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1506 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1507 && f
->output_data
.x
->cross_cursor
!= 0)
1508 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1509 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1511 XFlush (FRAME_X_DISPLAY (f
));
1514 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1518 x_set_cursor_color (f
, arg
, oldval
)
1520 Lisp_Object arg
, oldval
;
1522 unsigned long fore_pixel
, pixel
;
1523 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1525 if (!NILP (Vx_cursor_fore_pixel
))
1527 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1528 WHITE_PIX_DEFAULT (f
));
1529 fore_pixel_allocated_p
= 1;
1532 fore_pixel
= f
->output_data
.x
->background_pixel
;
1534 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1535 pixel_allocated_p
= 1;
1537 /* Make sure that the cursor color differs from the background color. */
1538 if (pixel
== f
->output_data
.x
->background_pixel
)
1540 if (pixel_allocated_p
)
1542 x_free_colors (f
, &pixel
, 1);
1543 pixel_allocated_p
= 0;
1546 pixel
= f
->output_data
.x
->mouse_pixel
;
1547 if (pixel
== fore_pixel
)
1549 if (fore_pixel_allocated_p
)
1551 x_free_colors (f
, &fore_pixel
, 1);
1552 fore_pixel_allocated_p
= 0;
1554 fore_pixel
= f
->output_data
.x
->background_pixel
;
1558 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1559 if (!fore_pixel_allocated_p
)
1560 fore_pixel
= x_copy_color (f
, fore_pixel
);
1561 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1563 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1564 if (!pixel_allocated_p
)
1565 pixel
= x_copy_color (f
, pixel
);
1566 f
->output_data
.x
->cursor_pixel
= pixel
;
1568 if (FRAME_X_WINDOW (f
) != 0)
1571 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1572 f
->output_data
.x
->cursor_pixel
);
1573 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1577 if (FRAME_VISIBLE_P (f
))
1579 x_update_cursor (f
, 0);
1580 x_update_cursor (f
, 1);
1584 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1587 /* Set the border-color of frame F to value described by ARG.
1588 ARG can be a string naming a color.
1589 The border-color is used for the border that is drawn by the X server.
1590 Note that this does not fully take effect if done before
1591 F has an x-window; it must be redone when the window is created.
1593 Note: this is done in two routines because of the way X10 works.
1595 Note: under X11, this is normally the province of the window manager,
1596 and so emacs' border colors may be overridden. */
1599 x_set_border_color (f
, arg
, oldval
)
1601 Lisp_Object arg
, oldval
;
1605 CHECK_STRING (arg
, 0);
1606 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1607 x_set_border_pixel (f
, pix
);
1608 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1611 /* Set the border-color of frame F to pixel value PIX.
1612 Note that this does not fully take effect if done before
1613 F has an x-window. */
1616 x_set_border_pixel (f
, pix
)
1620 unload_color (f
, f
->output_data
.x
->border_pixel
);
1621 f
->output_data
.x
->border_pixel
= pix
;
1623 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1626 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1627 (unsigned long)pix
);
1630 if (FRAME_VISIBLE_P (f
))
1636 /* Value is the internal representation of the specified cursor type
1637 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1638 of the bar cursor. */
1640 enum text_cursor_kinds
1641 x_specified_cursor_type (arg
, width
)
1645 enum text_cursor_kinds type
;
1652 else if (CONSP (arg
)
1653 && EQ (XCAR (arg
), Qbar
)
1654 && INTEGERP (XCDR (arg
))
1655 && XINT (XCDR (arg
)) >= 0)
1658 *width
= XINT (XCDR (arg
));
1660 else if (NILP (arg
))
1663 /* Treat anything unknown as "box cursor".
1664 It was bad to signal an error; people have trouble fixing
1665 .Xdefaults with Emacs, when it has something bad in it. */
1666 type
= FILLED_BOX_CURSOR
;
1672 x_set_cursor_type (f
, arg
, oldval
)
1674 Lisp_Object arg
, oldval
;
1678 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1679 f
->output_data
.x
->cursor_width
= width
;
1681 /* Make sure the cursor gets redrawn. This is overkill, but how
1682 often do people change cursor types? */
1683 update_mode_lines
++;
1687 x_set_icon_type (f
, arg
, oldval
)
1689 Lisp_Object arg
, oldval
;
1695 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1698 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1703 result
= x_text_icon (f
,
1704 (char *) XSTRING ((!NILP (f
->icon_name
)
1708 result
= x_bitmap_icon (f
, arg
);
1713 error ("No icon window available");
1716 XFlush (FRAME_X_DISPLAY (f
));
1720 /* Return non-nil if frame F wants a bitmap icon. */
1728 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1736 x_set_icon_name (f
, arg
, oldval
)
1738 Lisp_Object arg
, oldval
;
1744 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1747 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1752 if (f
->output_data
.x
->icon_bitmap
!= 0)
1757 result
= x_text_icon (f
,
1758 (char *) XSTRING ((!NILP (f
->icon_name
)
1767 error ("No icon window available");
1770 XFlush (FRAME_X_DISPLAY (f
));
1775 x_set_font (f
, arg
, oldval
)
1777 Lisp_Object arg
, oldval
;
1780 Lisp_Object fontset_name
;
1783 CHECK_STRING (arg
, 1);
1785 fontset_name
= Fquery_fontset (arg
, Qnil
);
1788 result
= (STRINGP (fontset_name
)
1789 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1790 : x_new_font (f
, XSTRING (arg
)->data
));
1793 if (EQ (result
, Qnil
))
1794 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1795 else if (EQ (result
, Qt
))
1796 error ("The characters of the given font have varying widths");
1797 else if (STRINGP (result
))
1799 store_frame_param (f
, Qfont
, result
);
1800 recompute_basic_faces (f
);
1805 do_pending_window_change (0);
1807 /* Don't call `face-set-after-frame-default' when faces haven't been
1808 initialized yet. This is the case when called from
1809 Fx_create_frame. In that case, the X widget or window doesn't
1810 exist either, and we can end up in x_report_frame_params with a
1811 null widget which gives a segfault. */
1812 if (FRAME_FACE_CACHE (f
))
1814 XSETFRAME (frame
, f
);
1815 call1 (Qface_set_after_frame_default
, frame
);
1820 x_set_border_width (f
, arg
, oldval
)
1822 Lisp_Object arg
, oldval
;
1824 CHECK_NUMBER (arg
, 0);
1826 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1829 if (FRAME_X_WINDOW (f
) != 0)
1830 error ("Cannot change the border width of a window");
1832 f
->output_data
.x
->border_width
= XINT (arg
);
1836 x_set_internal_border_width (f
, arg
, oldval
)
1838 Lisp_Object arg
, oldval
;
1840 int old
= f
->output_data
.x
->internal_border_width
;
1842 CHECK_NUMBER (arg
, 0);
1843 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1844 if (f
->output_data
.x
->internal_border_width
< 0)
1845 f
->output_data
.x
->internal_border_width
= 0;
1847 #ifdef USE_X_TOOLKIT
1848 if (f
->output_data
.x
->edit_widget
)
1849 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1852 if (f
->output_data
.x
->internal_border_width
== old
)
1855 if (FRAME_X_WINDOW (f
) != 0)
1857 x_set_window_size (f
, 0, f
->width
, f
->height
);
1858 SET_FRAME_GARBAGED (f
);
1859 do_pending_window_change (0);
1864 x_set_visibility (f
, value
, oldval
)
1866 Lisp_Object value
, oldval
;
1869 XSETFRAME (frame
, f
);
1872 Fmake_frame_invisible (frame
, Qt
);
1873 else if (EQ (value
, Qicon
))
1874 Ficonify_frame (frame
);
1876 Fmake_frame_visible (frame
);
1880 x_set_menu_bar_lines_1 (window
, n
)
1884 struct window
*w
= XWINDOW (window
);
1886 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1887 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1889 if (INTEGERP (w
->orig_top
))
1890 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1891 if (INTEGERP (w
->orig_height
))
1892 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1894 /* Handle just the top child in a vertical split. */
1895 if (!NILP (w
->vchild
))
1896 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1898 /* Adjust all children in a horizontal split. */
1899 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1901 w
= XWINDOW (window
);
1902 x_set_menu_bar_lines_1 (window
, n
);
1907 x_set_menu_bar_lines (f
, value
, oldval
)
1909 Lisp_Object value
, oldval
;
1912 #ifndef USE_X_TOOLKIT
1913 int olines
= FRAME_MENU_BAR_LINES (f
);
1916 /* Right now, menu bars don't work properly in minibuf-only frames;
1917 most of the commands try to apply themselves to the minibuffer
1918 frame itself, and get an error because you can't switch buffers
1919 in or split the minibuffer window. */
1920 if (FRAME_MINIBUF_ONLY_P (f
))
1923 if (INTEGERP (value
))
1924 nlines
= XINT (value
);
1928 /* Make sure we redisplay all windows in this frame. */
1929 windows_or_buffers_changed
++;
1931 #ifdef USE_X_TOOLKIT
1932 FRAME_MENU_BAR_LINES (f
) = 0;
1935 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1936 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1937 /* Make sure next redisplay shows the menu bar. */
1938 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1942 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1943 free_frame_menubar (f
);
1944 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1946 f
->output_data
.x
->menubar_widget
= 0;
1948 #else /* not USE_X_TOOLKIT */
1949 FRAME_MENU_BAR_LINES (f
) = nlines
;
1950 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1951 #endif /* not USE_X_TOOLKIT */
1956 /* Set the number of lines used for the tool bar of frame F to VALUE.
1957 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1958 is the old number of tool bar lines. This function changes the
1959 height of all windows on frame F to match the new tool bar height.
1960 The frame's height doesn't change. */
1963 x_set_tool_bar_lines (f
, value
, oldval
)
1965 Lisp_Object value
, oldval
;
1969 /* Use VALUE only if an integer >= 0. */
1970 if (INTEGERP (value
) && XINT (value
) >= 0)
1971 nlines
= XFASTINT (value
);
1975 /* Make sure we redisplay all windows in this frame. */
1976 ++windows_or_buffers_changed
;
1978 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1979 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1980 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
1985 /* Set the foreground color for scroll bars on frame F to VALUE.
1986 VALUE should be a string, a color name. If it isn't a string or
1987 isn't a valid color name, do nothing. OLDVAL is the old value of
1988 the frame parameter. */
1991 x_set_scroll_bar_foreground (f
, value
, oldval
)
1993 Lisp_Object value
, oldval
;
1995 unsigned long pixel
;
1997 if (STRINGP (value
))
1998 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2002 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2003 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2005 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2006 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2008 /* Remove all scroll bars because they have wrong colors. */
2009 if (condemn_scroll_bars_hook
)
2010 (*condemn_scroll_bars_hook
) (f
);
2011 if (judge_scroll_bars_hook
)
2012 (*judge_scroll_bars_hook
) (f
);
2014 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2020 /* Set the background color for scroll bars on frame F to VALUE VALUE
2021 should be a string, a color name. If it isn't a string or isn't a
2022 valid color name, do nothing. OLDVAL is the old value of the frame
2026 x_set_scroll_bar_background (f
, value
, oldval
)
2028 Lisp_Object value
, oldval
;
2030 unsigned long pixel
;
2032 if (STRINGP (value
))
2033 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2037 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2038 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2040 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2041 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2043 /* Remove all scroll bars because they have wrong colors. */
2044 if (condemn_scroll_bars_hook
)
2045 (*condemn_scroll_bars_hook
) (f
);
2046 if (judge_scroll_bars_hook
)
2047 (*judge_scroll_bars_hook
) (f
);
2049 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2055 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2058 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2059 name; if NAME is a string, set F's name to NAME and set
2060 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2062 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2063 suggesting a new name, which lisp code should override; if
2064 F->explicit_name is set, ignore the new name; otherwise, set it. */
2067 x_set_name (f
, name
, explicit)
2072 /* Make sure that requests from lisp code override requests from
2073 Emacs redisplay code. */
2076 /* If we're switching from explicit to implicit, we had better
2077 update the mode lines and thereby update the title. */
2078 if (f
->explicit_name
&& NILP (name
))
2079 update_mode_lines
= 1;
2081 f
->explicit_name
= ! NILP (name
);
2083 else if (f
->explicit_name
)
2086 /* If NAME is nil, set the name to the x_id_name. */
2089 /* Check for no change needed in this very common case
2090 before we do any consing. */
2091 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2092 XSTRING (f
->name
)->data
))
2094 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2097 CHECK_STRING (name
, 0);
2099 /* Don't change the name if it's already NAME. */
2100 if (! NILP (Fstring_equal (name
, f
->name
)))
2105 /* For setting the frame title, the title parameter should override
2106 the name parameter. */
2107 if (! NILP (f
->title
))
2110 if (FRAME_X_WINDOW (f
))
2115 XTextProperty text
, icon
;
2116 Lisp_Object icon_name
;
2118 text
.value
= XSTRING (name
)->data
;
2119 text
.encoding
= XA_STRING
;
2121 text
.nitems
= STRING_BYTES (XSTRING (name
));
2123 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2125 icon
.value
= XSTRING (icon_name
)->data
;
2126 icon
.encoding
= XA_STRING
;
2128 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2129 #ifdef USE_X_TOOLKIT
2130 XSetWMName (FRAME_X_DISPLAY (f
),
2131 XtWindow (f
->output_data
.x
->widget
), &text
);
2132 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2134 #else /* not USE_X_TOOLKIT */
2135 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2136 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2137 #endif /* not USE_X_TOOLKIT */
2139 #else /* not HAVE_X11R4 */
2140 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2141 XSTRING (name
)->data
);
2142 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2143 XSTRING (name
)->data
);
2144 #endif /* not HAVE_X11R4 */
2149 /* This function should be called when the user's lisp code has
2150 specified a name for the frame; the name will override any set by the
2153 x_explicitly_set_name (f
, arg
, oldval
)
2155 Lisp_Object arg
, oldval
;
2157 x_set_name (f
, arg
, 1);
2160 /* This function should be called by Emacs redisplay code to set the
2161 name; names set this way will never override names set by the user's
2164 x_implicitly_set_name (f
, arg
, oldval
)
2166 Lisp_Object arg
, oldval
;
2168 x_set_name (f
, arg
, 0);
2171 /* Change the title of frame F to NAME.
2172 If NAME is nil, use the frame name as the title.
2174 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2175 name; if NAME is a string, set F's name to NAME and set
2176 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2178 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2179 suggesting a new name, which lisp code should override; if
2180 F->explicit_name is set, ignore the new name; otherwise, set it. */
2183 x_set_title (f
, name
, old_name
)
2185 Lisp_Object name
, old_name
;
2187 /* Don't change the title if it's already NAME. */
2188 if (EQ (name
, f
->title
))
2191 update_mode_lines
= 1;
2198 CHECK_STRING (name
, 0);
2200 if (FRAME_X_WINDOW (f
))
2205 XTextProperty text
, icon
;
2206 Lisp_Object icon_name
;
2208 text
.value
= XSTRING (name
)->data
;
2209 text
.encoding
= XA_STRING
;
2211 text
.nitems
= STRING_BYTES (XSTRING (name
));
2213 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2215 icon
.value
= XSTRING (icon_name
)->data
;
2216 icon
.encoding
= XA_STRING
;
2218 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2219 #ifdef USE_X_TOOLKIT
2220 XSetWMName (FRAME_X_DISPLAY (f
),
2221 XtWindow (f
->output_data
.x
->widget
), &text
);
2222 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2224 #else /* not USE_X_TOOLKIT */
2225 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2226 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2227 #endif /* not USE_X_TOOLKIT */
2229 #else /* not HAVE_X11R4 */
2230 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2231 XSTRING (name
)->data
);
2232 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2233 XSTRING (name
)->data
);
2234 #endif /* not HAVE_X11R4 */
2240 x_set_autoraise (f
, arg
, oldval
)
2242 Lisp_Object arg
, oldval
;
2244 f
->auto_raise
= !EQ (Qnil
, arg
);
2248 x_set_autolower (f
, arg
, oldval
)
2250 Lisp_Object arg
, oldval
;
2252 f
->auto_lower
= !EQ (Qnil
, arg
);
2256 x_set_unsplittable (f
, arg
, oldval
)
2258 Lisp_Object arg
, oldval
;
2260 f
->no_split
= !NILP (arg
);
2264 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2266 Lisp_Object arg
, oldval
;
2268 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2269 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2270 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2271 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2273 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2275 ? vertical_scroll_bar_none
2277 ? vertical_scroll_bar_right
2278 : vertical_scroll_bar_left
);
2280 /* We set this parameter before creating the X window for the
2281 frame, so we can get the geometry right from the start.
2282 However, if the window hasn't been created yet, we shouldn't
2283 call x_set_window_size. */
2284 if (FRAME_X_WINDOW (f
))
2285 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2286 do_pending_window_change (0);
2291 x_set_scroll_bar_width (f
, arg
, oldval
)
2293 Lisp_Object arg
, oldval
;
2295 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2299 #ifdef USE_TOOLKIT_SCROLL_BARS
2300 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2301 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2302 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2303 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2305 /* Make the actual width at least 14 pixels and a multiple of a
2307 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2309 /* Use all of that space (aside from required margins) for the
2311 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2314 if (FRAME_X_WINDOW (f
))
2315 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2316 do_pending_window_change (0);
2318 else if (INTEGERP (arg
) && XINT (arg
) > 0
2319 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2321 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2322 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2324 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2325 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2326 if (FRAME_X_WINDOW (f
))
2327 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2330 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2331 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2332 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2337 /* Subroutines of creating an X frame. */
2339 /* Make sure that Vx_resource_name is set to a reasonable value.
2340 Fix it up, or set it to `emacs' if it is too hopeless. */
2343 validate_x_resource_name ()
2346 /* Number of valid characters in the resource name. */
2348 /* Number of invalid characters in the resource name. */
2353 if (!STRINGP (Vx_resource_class
))
2354 Vx_resource_class
= build_string (EMACS_CLASS
);
2356 if (STRINGP (Vx_resource_name
))
2358 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2361 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2363 /* Only letters, digits, - and _ are valid in resource names.
2364 Count the valid characters and count the invalid ones. */
2365 for (i
= 0; i
< len
; i
++)
2368 if (! ((c
>= 'a' && c
<= 'z')
2369 || (c
>= 'A' && c
<= 'Z')
2370 || (c
>= '0' && c
<= '9')
2371 || c
== '-' || c
== '_'))
2378 /* Not a string => completely invalid. */
2379 bad_count
= 5, good_count
= 0;
2381 /* If name is valid already, return. */
2385 /* If name is entirely invalid, or nearly so, use `emacs'. */
2387 || (good_count
== 1 && bad_count
> 0))
2389 Vx_resource_name
= build_string ("emacs");
2393 /* Name is partly valid. Copy it and replace the invalid characters
2394 with underscores. */
2396 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2398 for (i
= 0; i
< len
; i
++)
2400 int c
= XSTRING (new)->data
[i
];
2401 if (! ((c
>= 'a' && c
<= 'z')
2402 || (c
>= 'A' && c
<= 'Z')
2403 || (c
>= '0' && c
<= '9')
2404 || c
== '-' || c
== '_'))
2405 XSTRING (new)->data
[i
] = '_';
2410 extern char *x_get_string_resource ();
2412 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2413 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2414 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2415 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2416 the name specified by the `-name' or `-rn' command-line arguments.\n\
2418 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2419 class, respectively. You must specify both of them or neither.\n\
2420 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2421 and the class is `Emacs.CLASS.SUBCLASS'.")
2422 (attribute
, class, component
, subclass
)
2423 Lisp_Object attribute
, class, component
, subclass
;
2425 register char *value
;
2431 CHECK_STRING (attribute
, 0);
2432 CHECK_STRING (class, 0);
2434 if (!NILP (component
))
2435 CHECK_STRING (component
, 1);
2436 if (!NILP (subclass
))
2437 CHECK_STRING (subclass
, 2);
2438 if (NILP (component
) != NILP (subclass
))
2439 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2441 validate_x_resource_name ();
2443 /* Allocate space for the components, the dots which separate them,
2444 and the final '\0'. Make them big enough for the worst case. */
2445 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2446 + (STRINGP (component
)
2447 ? STRING_BYTES (XSTRING (component
)) : 0)
2448 + STRING_BYTES (XSTRING (attribute
))
2451 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2452 + STRING_BYTES (XSTRING (class))
2453 + (STRINGP (subclass
)
2454 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2457 /* Start with emacs.FRAMENAME for the name (the specific one)
2458 and with `Emacs' for the class key (the general one). */
2459 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2460 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2462 strcat (class_key
, ".");
2463 strcat (class_key
, XSTRING (class)->data
);
2465 if (!NILP (component
))
2467 strcat (class_key
, ".");
2468 strcat (class_key
, XSTRING (subclass
)->data
);
2470 strcat (name_key
, ".");
2471 strcat (name_key
, XSTRING (component
)->data
);
2474 strcat (name_key
, ".");
2475 strcat (name_key
, XSTRING (attribute
)->data
);
2477 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2478 name_key
, class_key
);
2480 if (value
!= (char *) 0)
2481 return build_string (value
);
2486 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2489 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2490 struct x_display_info
*dpyinfo
;
2491 Lisp_Object attribute
, class, component
, subclass
;
2493 register char *value
;
2497 CHECK_STRING (attribute
, 0);
2498 CHECK_STRING (class, 0);
2500 if (!NILP (component
))
2501 CHECK_STRING (component
, 1);
2502 if (!NILP (subclass
))
2503 CHECK_STRING (subclass
, 2);
2504 if (NILP (component
) != NILP (subclass
))
2505 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2507 validate_x_resource_name ();
2509 /* Allocate space for the components, the dots which separate them,
2510 and the final '\0'. Make them big enough for the worst case. */
2511 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2512 + (STRINGP (component
)
2513 ? STRING_BYTES (XSTRING (component
)) : 0)
2514 + STRING_BYTES (XSTRING (attribute
))
2517 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2518 + STRING_BYTES (XSTRING (class))
2519 + (STRINGP (subclass
)
2520 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2523 /* Start with emacs.FRAMENAME for the name (the specific one)
2524 and with `Emacs' for the class key (the general one). */
2525 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2526 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2528 strcat (class_key
, ".");
2529 strcat (class_key
, XSTRING (class)->data
);
2531 if (!NILP (component
))
2533 strcat (class_key
, ".");
2534 strcat (class_key
, XSTRING (subclass
)->data
);
2536 strcat (name_key
, ".");
2537 strcat (name_key
, XSTRING (component
)->data
);
2540 strcat (name_key
, ".");
2541 strcat (name_key
, XSTRING (attribute
)->data
);
2543 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2545 if (value
!= (char *) 0)
2546 return build_string (value
);
2551 /* Used when C code wants a resource value. */
2554 x_get_resource_string (attribute
, class)
2555 char *attribute
, *class;
2559 struct frame
*sf
= SELECTED_FRAME ();
2561 /* Allocate space for the components, the dots which separate them,
2562 and the final '\0'. */
2563 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2564 + strlen (attribute
) + 2);
2565 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2566 + strlen (class) + 2);
2568 sprintf (name_key
, "%s.%s",
2569 XSTRING (Vinvocation_name
)->data
,
2571 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2573 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2574 name_key
, class_key
);
2577 /* Types we might convert a resource string into. */
2587 /* Return the value of parameter PARAM.
2589 First search ALIST, then Vdefault_frame_alist, then the X defaults
2590 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2592 Convert the resource to the type specified by desired_type.
2594 If no default is specified, return Qunbound. If you call
2595 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2596 and don't let it get stored in any Lisp-visible variables! */
2599 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2600 struct x_display_info
*dpyinfo
;
2601 Lisp_Object alist
, param
;
2604 enum resource_types type
;
2606 register Lisp_Object tem
;
2608 tem
= Fassq (param
, alist
);
2610 tem
= Fassq (param
, Vdefault_frame_alist
);
2616 tem
= display_x_get_resource (dpyinfo
,
2617 build_string (attribute
),
2618 build_string (class),
2626 case RES_TYPE_NUMBER
:
2627 return make_number (atoi (XSTRING (tem
)->data
));
2629 case RES_TYPE_FLOAT
:
2630 return make_float (atof (XSTRING (tem
)->data
));
2632 case RES_TYPE_BOOLEAN
:
2633 tem
= Fdowncase (tem
);
2634 if (!strcmp (XSTRING (tem
)->data
, "on")
2635 || !strcmp (XSTRING (tem
)->data
, "true"))
2640 case RES_TYPE_STRING
:
2643 case RES_TYPE_SYMBOL
:
2644 /* As a special case, we map the values `true' and `on'
2645 to Qt, and `false' and `off' to Qnil. */
2648 lower
= Fdowncase (tem
);
2649 if (!strcmp (XSTRING (lower
)->data
, "on")
2650 || !strcmp (XSTRING (lower
)->data
, "true"))
2652 else if (!strcmp (XSTRING (lower
)->data
, "off")
2653 || !strcmp (XSTRING (lower
)->data
, "false"))
2656 return Fintern (tem
, Qnil
);
2669 /* Like x_get_arg, but also record the value in f->param_alist. */
2672 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2674 Lisp_Object alist
, param
;
2677 enum resource_types type
;
2681 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2682 attribute
, class, type
);
2684 store_frame_param (f
, param
, value
);
2689 /* Record in frame F the specified or default value according to ALIST
2690 of the parameter named PROP (a Lisp symbol).
2691 If no value is specified for PROP, look for an X default for XPROP
2692 on the frame named NAME.
2693 If that is not found either, use the value DEFLT. */
2696 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2703 enum resource_types type
;
2707 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2708 if (EQ (tem
, Qunbound
))
2710 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2715 /* Record in frame F the specified or default value according to ALIST
2716 of the parameter named PROP (a Lisp symbol). If no value is
2717 specified for PROP, look for an X default for XPROP on the frame
2718 named NAME. If that is not found either, use the value DEFLT. */
2721 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2730 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2733 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2734 if (EQ (tem
, Qunbound
))
2736 #ifdef USE_TOOLKIT_SCROLL_BARS
2738 /* See if an X resource for the scroll bar color has been
2740 tem
= display_x_get_resource (dpyinfo
,
2741 build_string (foreground_p
2745 build_string ("verticalScrollBar"),
2749 /* If nothing has been specified, scroll bars will use a
2750 toolkit-dependent default. Because these defaults are
2751 difficult to get at without actually creating a scroll
2752 bar, use nil to indicate that no color has been
2757 #else /* not USE_TOOLKIT_SCROLL_BARS */
2761 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2764 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2770 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2771 "Parse an X-style geometry string STRING.\n\
2772 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2773 The properties returned may include `top', `left', `height', and `width'.\n\
2774 The value of `left' or `top' may be an integer,\n\
2775 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2776 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2781 unsigned int width
, height
;
2784 CHECK_STRING (string
, 0);
2786 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2787 &x
, &y
, &width
, &height
);
2790 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2791 error ("Must specify both x and y position, or neither");
2795 if (geometry
& XValue
)
2797 Lisp_Object element
;
2799 if (x
>= 0 && (geometry
& XNegative
))
2800 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2801 else if (x
< 0 && ! (geometry
& XNegative
))
2802 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2804 element
= Fcons (Qleft
, make_number (x
));
2805 result
= Fcons (element
, result
);
2808 if (geometry
& YValue
)
2810 Lisp_Object element
;
2812 if (y
>= 0 && (geometry
& YNegative
))
2813 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2814 else if (y
< 0 && ! (geometry
& YNegative
))
2815 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2817 element
= Fcons (Qtop
, make_number (y
));
2818 result
= Fcons (element
, result
);
2821 if (geometry
& WidthValue
)
2822 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2823 if (geometry
& HeightValue
)
2824 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2829 /* Calculate the desired size and position of this window,
2830 and return the flags saying which aspects were specified.
2832 This function does not make the coordinates positive. */
2834 #define DEFAULT_ROWS 40
2835 #define DEFAULT_COLS 80
2838 x_figure_window_size (f
, parms
)
2842 register Lisp_Object tem0
, tem1
, tem2
;
2843 long window_prompting
= 0;
2844 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2846 /* Default values if we fall through.
2847 Actually, if that happens we should get
2848 window manager prompting. */
2849 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2850 f
->height
= DEFAULT_ROWS
;
2851 /* Window managers expect that if program-specified
2852 positions are not (0,0), they're intentional, not defaults. */
2853 f
->output_data
.x
->top_pos
= 0;
2854 f
->output_data
.x
->left_pos
= 0;
2856 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2857 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2858 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2859 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2861 if (!EQ (tem0
, Qunbound
))
2863 CHECK_NUMBER (tem0
, 0);
2864 f
->height
= XINT (tem0
);
2866 if (!EQ (tem1
, Qunbound
))
2868 CHECK_NUMBER (tem1
, 0);
2869 SET_FRAME_WIDTH (f
, XINT (tem1
));
2871 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2872 window_prompting
|= USSize
;
2874 window_prompting
|= PSize
;
2877 f
->output_data
.x
->vertical_scroll_bar_extra
2878 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2880 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2881 f
->output_data
.x
->flags_areas_extra
2882 = FRAME_FLAGS_AREA_WIDTH (f
);
2883 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2884 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2886 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2887 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2888 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2889 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2891 if (EQ (tem0
, Qminus
))
2893 f
->output_data
.x
->top_pos
= 0;
2894 window_prompting
|= YNegative
;
2896 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2897 && CONSP (XCDR (tem0
))
2898 && INTEGERP (XCAR (XCDR (tem0
))))
2900 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2901 window_prompting
|= YNegative
;
2903 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2904 && CONSP (XCDR (tem0
))
2905 && INTEGERP (XCAR (XCDR (tem0
))))
2907 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2909 else if (EQ (tem0
, Qunbound
))
2910 f
->output_data
.x
->top_pos
= 0;
2913 CHECK_NUMBER (tem0
, 0);
2914 f
->output_data
.x
->top_pos
= XINT (tem0
);
2915 if (f
->output_data
.x
->top_pos
< 0)
2916 window_prompting
|= YNegative
;
2919 if (EQ (tem1
, Qminus
))
2921 f
->output_data
.x
->left_pos
= 0;
2922 window_prompting
|= XNegative
;
2924 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2925 && CONSP (XCDR (tem1
))
2926 && INTEGERP (XCAR (XCDR (tem1
))))
2928 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2929 window_prompting
|= XNegative
;
2931 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2932 && CONSP (XCDR (tem1
))
2933 && INTEGERP (XCAR (XCDR (tem1
))))
2935 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2937 else if (EQ (tem1
, Qunbound
))
2938 f
->output_data
.x
->left_pos
= 0;
2941 CHECK_NUMBER (tem1
, 0);
2942 f
->output_data
.x
->left_pos
= XINT (tem1
);
2943 if (f
->output_data
.x
->left_pos
< 0)
2944 window_prompting
|= XNegative
;
2947 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2948 window_prompting
|= USPosition
;
2950 window_prompting
|= PPosition
;
2953 return window_prompting
;
2956 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2959 XSetWMProtocols (dpy
, w
, protocols
, count
)
2966 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2967 if (prop
== None
) return False
;
2968 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2969 (unsigned char *) protocols
, count
);
2972 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2974 #ifdef USE_X_TOOLKIT
2976 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2977 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2978 already be present because of the toolkit (Motif adds some of them,
2979 for example, but Xt doesn't). */
2982 hack_wm_protocols (f
, widget
)
2986 Display
*dpy
= XtDisplay (widget
);
2987 Window w
= XtWindow (widget
);
2988 int need_delete
= 1;
2994 Atom type
, *atoms
= 0;
2996 unsigned long nitems
= 0;
2997 unsigned long bytes_after
;
2999 if ((XGetWindowProperty (dpy
, w
,
3000 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3001 (long)0, (long)100, False
, XA_ATOM
,
3002 &type
, &format
, &nitems
, &bytes_after
,
3003 (unsigned char **) &atoms
)
3005 && format
== 32 && type
== XA_ATOM
)
3009 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3011 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3013 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3016 if (atoms
) XFree ((char *) atoms
);
3022 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3024 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3026 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3028 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3029 XA_ATOM
, 32, PropModeAppend
,
3030 (unsigned char *) props
, count
);
3038 /* Support routines for XIC (X Input Context). */
3042 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3043 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3046 /* Supported XIM styles, ordered by preferenc. */
3048 static XIMStyle supported_xim_styles
[] =
3050 XIMPreeditPosition
| XIMStatusArea
,
3051 XIMPreeditPosition
| XIMStatusNothing
,
3052 XIMPreeditPosition
| XIMStatusNone
,
3053 XIMPreeditNothing
| XIMStatusArea
,
3054 XIMPreeditNothing
| XIMStatusNothing
,
3055 XIMPreeditNothing
| XIMStatusNone
,
3056 XIMPreeditNone
| XIMStatusArea
,
3057 XIMPreeditNone
| XIMStatusNothing
,
3058 XIMPreeditNone
| XIMStatusNone
,
3063 /* Create an X fontset on frame F with base font name
3067 xic_create_xfontset (f
, base_fontname
)
3069 char *base_fontname
;
3072 char **missing_list
;
3076 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3077 base_fontname
, &missing_list
,
3078 &missing_count
, &def_string
);
3080 XFreeStringList (missing_list
);
3082 /* No need to free def_string. */
3087 /* Value is the best input style, given user preferences USER (already
3088 checked to be supported by Emacs), and styles supported by the
3089 input method XIM. */
3092 best_xim_style (user
, xim
)
3098 for (i
= 0; i
< user
->count_styles
; ++i
)
3099 for (j
= 0; j
< xim
->count_styles
; ++j
)
3100 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3101 return user
->supported_styles
[i
];
3103 /* Return the default style. */
3104 return XIMPreeditNothing
| XIMStatusNothing
;
3107 /* Create XIC for frame F. */
3110 create_frame_xic (f
)
3115 XFontSet xfs
= NULL
;
3116 static XIMStyle xic_style
;
3121 xim
= FRAME_X_XIM (f
);
3126 XVaNestedList preedit_attr
;
3127 XVaNestedList status_attr
;
3128 char *base_fontname
;
3131 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3132 spot
.x
= 0; spot
.y
= 1;
3133 /* Create X fontset. */
3134 fontset
= FRAME_FONTSET (f
);
3136 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3139 /* Determine the base fontname from the ASCII font name of
3141 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3142 char *p
= ascii_font
;
3145 for (i
= 0; *p
; p
++)
3148 /* As the font name doesn't conform to XLFD, we can't
3149 modify it to get a suitable base fontname for the
3151 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3154 int len
= strlen (ascii_font
) + 1;
3157 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3166 base_fontname
= (char *) alloca (len
);
3167 bzero (base_fontname
, len
);
3168 strcpy (base_fontname
, "-*-*-");
3169 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3170 strcat (base_fontname
, "*-*-*-*-*-*-*");
3173 xfs
= xic_create_xfontset (f
, base_fontname
);
3175 /* Determine XIC style. */
3178 XIMStyles supported_list
;
3179 supported_list
.count_styles
= (sizeof supported_xim_styles
3180 / sizeof supported_xim_styles
[0]);
3181 supported_list
.supported_styles
= supported_xim_styles
;
3182 xic_style
= best_xim_style (&supported_list
,
3183 FRAME_X_XIM_STYLES (f
));
3186 preedit_attr
= XVaCreateNestedList (0,
3189 FRAME_FOREGROUND_PIXEL (f
),
3191 FRAME_BACKGROUND_PIXEL (f
),
3192 (xic_style
& XIMPreeditPosition
3197 status_attr
= XVaCreateNestedList (0,
3203 FRAME_FOREGROUND_PIXEL (f
),
3205 FRAME_BACKGROUND_PIXEL (f
),
3208 xic
= XCreateIC (xim
,
3209 XNInputStyle
, xic_style
,
3210 XNClientWindow
, FRAME_X_WINDOW(f
),
3211 XNFocusWindow
, FRAME_X_WINDOW(f
),
3212 XNStatusAttributes
, status_attr
,
3213 XNPreeditAttributes
, preedit_attr
,
3215 XFree (preedit_attr
);
3216 XFree (status_attr
);
3219 FRAME_XIC (f
) = xic
;
3220 FRAME_XIC_STYLE (f
) = xic_style
;
3221 FRAME_XIC_FONTSET (f
) = xfs
;
3225 /* Destroy XIC and free XIC fontset of frame F, if any. */
3231 if (FRAME_XIC (f
) == NULL
)
3234 XDestroyIC (FRAME_XIC (f
));
3235 if (FRAME_XIC_FONTSET (f
))
3236 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3238 FRAME_XIC (f
) = NULL
;
3239 FRAME_XIC_FONTSET (f
) = NULL
;
3243 /* Place preedit area for XIC of window W's frame to specified
3244 pixel position X/Y. X and Y are relative to window W. */
3247 xic_set_preeditarea (w
, x
, y
)
3251 struct frame
*f
= XFRAME (w
->frame
);
3255 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3256 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3257 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3258 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3263 /* Place status area for XIC in bottom right corner of frame F.. */
3266 xic_set_statusarea (f
)
3269 XIC xic
= FRAME_XIC (f
);
3274 /* Negotiate geometry of status area. If input method has existing
3275 status area, use its current size. */
3276 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3277 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3278 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3281 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3282 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3285 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3287 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3288 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3292 area
.width
= needed
->width
;
3293 area
.height
= needed
->height
;
3294 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3295 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3296 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3299 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3300 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3305 /* Set X fontset for XIC of frame F, using base font name
3306 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3309 xic_set_xfontset (f
, base_fontname
)
3311 char *base_fontname
;
3316 xfs
= xic_create_xfontset (f
, base_fontname
);
3318 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3319 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3320 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3321 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3322 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3325 if (FRAME_XIC_FONTSET (f
))
3326 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3327 FRAME_XIC_FONTSET (f
) = xfs
;
3330 #endif /* HAVE_X_I18N */
3334 #ifdef USE_X_TOOLKIT
3336 /* Create and set up the X widget for frame F. */
3339 x_window (f
, window_prompting
, minibuffer_only
)
3341 long window_prompting
;
3342 int minibuffer_only
;
3344 XClassHint class_hints
;
3345 XSetWindowAttributes attributes
;
3346 unsigned long attribute_mask
;
3347 Widget shell_widget
;
3349 Widget frame_widget
;
3355 /* Use the resource name as the top-level widget name
3356 for looking up resources. Make a non-Lisp copy
3357 for the window manager, so GC relocation won't bother it.
3359 Elsewhere we specify the window name for the window manager. */
3362 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3363 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3364 strcpy (f
->namebuf
, str
);
3368 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3369 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3370 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3371 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3372 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3373 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3374 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3375 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3376 applicationShellWidgetClass
,
3377 FRAME_X_DISPLAY (f
), al
, ac
);
3379 f
->output_data
.x
->widget
= shell_widget
;
3380 /* maybe_set_screen_title_format (shell_widget); */
3382 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3383 (widget_value
*) NULL
,
3384 shell_widget
, False
,
3388 (lw_callback
) NULL
);
3391 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3392 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3393 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3394 XtSetValues (pane_widget
, al
, ac
);
3395 f
->output_data
.x
->column_widget
= pane_widget
;
3397 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3398 the emacs screen when changing menubar. This reduces flickering. */
3401 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3402 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3403 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3404 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3405 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3406 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3407 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3408 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3409 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3412 f
->output_data
.x
->edit_widget
= frame_widget
;
3414 XtManageChild (frame_widget
);
3416 /* Do some needed geometry management. */
3419 char *tem
, shell_position
[32];
3422 int extra_borders
= 0;
3424 = (f
->output_data
.x
->menubar_widget
3425 ? (f
->output_data
.x
->menubar_widget
->core
.height
3426 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3429 #if 0 /* Experimentally, we now get the right results
3430 for -geometry -0-0 without this. 24 Aug 96, rms. */
3431 if (FRAME_EXTERNAL_MENU_BAR (f
))
3434 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3435 menubar_size
+= ibw
;
3439 f
->output_data
.x
->menubar_height
= menubar_size
;
3442 /* Motif seems to need this amount added to the sizes
3443 specified for the shell widget. The Athena/Lucid widgets don't.
3444 Both conclusions reached experimentally. -- rms. */
3445 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3446 &extra_borders
, NULL
);
3450 /* Convert our geometry parameters into a geometry string
3452 Note that we do not specify here whether the position
3453 is a user-specified or program-specified one.
3454 We pass that information later, in x_wm_set_size_hints. */
3456 int left
= f
->output_data
.x
->left_pos
;
3457 int xneg
= window_prompting
& XNegative
;
3458 int top
= f
->output_data
.x
->top_pos
;
3459 int yneg
= window_prompting
& YNegative
;
3465 if (window_prompting
& USPosition
)
3466 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3467 PIXEL_WIDTH (f
) + extra_borders
,
3468 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3469 (xneg
? '-' : '+'), left
,
3470 (yneg
? '-' : '+'), top
);
3472 sprintf (shell_position
, "=%dx%d",
3473 PIXEL_WIDTH (f
) + extra_borders
,
3474 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3477 len
= strlen (shell_position
) + 1;
3478 /* We don't free this because we don't know whether
3479 it is safe to free it while the frame exists.
3480 It isn't worth the trouble of arranging to free it
3481 when the frame is deleted. */
3482 tem
= (char *) xmalloc (len
);
3483 strncpy (tem
, shell_position
, len
);
3484 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3485 XtSetValues (shell_widget
, al
, ac
);
3488 XtManageChild (pane_widget
);
3489 XtRealizeWidget (shell_widget
);
3491 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3493 validate_x_resource_name ();
3495 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3496 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3497 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3500 FRAME_XIC (f
) = NULL
;
3501 create_frame_xic (f
);
3504 f
->output_data
.x
->wm_hints
.input
= True
;
3505 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3506 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3507 &f
->output_data
.x
->wm_hints
);
3509 hack_wm_protocols (f
, shell_widget
);
3512 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3515 /* Do a stupid property change to force the server to generate a
3516 PropertyNotify event so that the event_stream server timestamp will
3517 be initialized to something relevant to the time we created the window.
3519 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3520 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3521 XA_ATOM
, 32, PropModeAppend
,
3522 (unsigned char*) NULL
, 0);
3524 /* Make all the standard events reach the Emacs frame. */
3525 attributes
.event_mask
= STANDARD_EVENT_SET
;
3530 /* XIM server might require some X events. */
3531 unsigned long fevent
= NoEventMask
;
3532 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3533 attributes
.event_mask
|= fevent
;
3535 #endif /* HAVE_X_I18N */
3537 attribute_mask
= CWEventMask
;
3538 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3539 attribute_mask
, &attributes
);
3541 XtMapWidget (frame_widget
);
3543 /* x_set_name normally ignores requests to set the name if the
3544 requested name is the same as the current name. This is the one
3545 place where that assumption isn't correct; f->name is set, but
3546 the X server hasn't been told. */
3549 int explicit = f
->explicit_name
;
3551 f
->explicit_name
= 0;
3554 x_set_name (f
, name
, explicit);
3557 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3558 f
->output_data
.x
->text_cursor
);
3562 /* This is a no-op, except under Motif. Make sure main areas are
3563 set to something reasonable, in case we get an error later. */
3564 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3567 #else /* not USE_X_TOOLKIT */
3569 /* Create and set up the X window for frame F. */
3576 XClassHint class_hints
;
3577 XSetWindowAttributes attributes
;
3578 unsigned long attribute_mask
;
3580 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3581 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3582 attributes
.bit_gravity
= StaticGravity
;
3583 attributes
.backing_store
= NotUseful
;
3584 attributes
.save_under
= True
;
3585 attributes
.event_mask
= STANDARD_EVENT_SET
;
3586 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3587 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3592 = XCreateWindow (FRAME_X_DISPLAY (f
),
3593 f
->output_data
.x
->parent_desc
,
3594 f
->output_data
.x
->left_pos
,
3595 f
->output_data
.x
->top_pos
,
3596 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3597 f
->output_data
.x
->border_width
,
3598 CopyFromParent
, /* depth */
3599 InputOutput
, /* class */
3601 attribute_mask
, &attributes
);
3604 create_frame_xic (f
);
3607 /* XIM server might require some X events. */
3608 unsigned long fevent
= NoEventMask
;
3609 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3610 attributes
.event_mask
|= fevent
;
3611 attribute_mask
= CWEventMask
;
3612 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3613 attribute_mask
, &attributes
);
3615 #endif /* HAVE_X_I18N */
3617 validate_x_resource_name ();
3619 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3620 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3621 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3623 /* The menubar is part of the ordinary display;
3624 it does not count in addition to the height of the window. */
3625 f
->output_data
.x
->menubar_height
= 0;
3627 /* This indicates that we use the "Passive Input" input model.
3628 Unless we do this, we don't get the Focus{In,Out} events that we
3629 need to draw the cursor correctly. Accursed bureaucrats.
3630 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3632 f
->output_data
.x
->wm_hints
.input
= True
;
3633 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3634 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3635 &f
->output_data
.x
->wm_hints
);
3636 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3638 /* Request "save yourself" and "delete window" commands from wm. */
3641 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3642 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3643 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3646 /* x_set_name normally ignores requests to set the name if the
3647 requested name is the same as the current name. This is the one
3648 place where that assumption isn't correct; f->name is set, but
3649 the X server hasn't been told. */
3652 int explicit = f
->explicit_name
;
3654 f
->explicit_name
= 0;
3657 x_set_name (f
, name
, explicit);
3660 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3661 f
->output_data
.x
->text_cursor
);
3665 if (FRAME_X_WINDOW (f
) == 0)
3666 error ("Unable to create window");
3669 #endif /* not USE_X_TOOLKIT */
3671 /* Handle the icon stuff for this window. Perhaps later we might
3672 want an x_set_icon_position which can be called interactively as
3680 Lisp_Object icon_x
, icon_y
;
3681 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3683 /* Set the position of the icon. Note that twm groups all
3684 icons in an icon window. */
3685 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3686 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3687 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3689 CHECK_NUMBER (icon_x
, 0);
3690 CHECK_NUMBER (icon_y
, 0);
3692 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3693 error ("Both left and top icon corners of icon must be specified");
3697 if (! EQ (icon_x
, Qunbound
))
3698 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3700 /* Start up iconic or window? */
3701 x_wm_set_window_state
3702 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3707 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3714 /* Make the GC's needed for this window, setting the
3715 background, border and mouse colors; also create the
3716 mouse cursor and the gray border tile. */
3718 static char cursor_bits
[] =
3720 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3721 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3722 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3723 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3730 XGCValues gc_values
;
3734 /* Create the GC's of this frame.
3735 Note that many default values are used. */
3738 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3739 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3740 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3741 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3742 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3744 GCLineWidth
| GCFont
3745 | GCForeground
| GCBackground
,
3748 /* Reverse video style. */
3749 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3750 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3751 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3753 GCFont
| GCForeground
| GCBackground
3757 /* Cursor has cursor-color background, background-color foreground. */
3758 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3759 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3760 gc_values
.fill_style
= FillOpaqueStippled
;
3762 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3763 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3764 cursor_bits
, 16, 16);
3765 f
->output_data
.x
->cursor_gc
3766 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3767 (GCFont
| GCForeground
| GCBackground
3768 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3772 f
->output_data
.x
->white_relief
.gc
= 0;
3773 f
->output_data
.x
->black_relief
.gc
= 0;
3775 /* Create the gray border tile used when the pointer is not in
3776 the frame. Since this depends on the frame's pixel values,
3777 this must be done on a per-frame basis. */
3778 f
->output_data
.x
->border_tile
3779 = (XCreatePixmapFromBitmapData
3780 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3781 gray_bits
, gray_width
, gray_height
,
3782 f
->output_data
.x
->foreground_pixel
,
3783 f
->output_data
.x
->background_pixel
,
3784 DefaultDepth (FRAME_X_DISPLAY (f
),
3785 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3790 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3792 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3793 Returns an Emacs frame object.\n\
3794 ALIST is an alist of frame parameters.\n\
3795 If the parameters specify that the frame should not have a minibuffer,\n\
3796 and do not specify a specific minibuffer window to use,\n\
3797 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3798 be shared by the new frame.\n\
3800 This function is an internal primitive--use `make-frame' instead.")
3805 Lisp_Object frame
, tem
;
3807 int minibuffer_only
= 0;
3808 long window_prompting
= 0;
3810 int count
= specpdl_ptr
- specpdl
;
3811 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3812 Lisp_Object display
;
3813 struct x_display_info
*dpyinfo
= NULL
;
3819 /* Use this general default value to start with
3820 until we know if this frame has a specified name. */
3821 Vx_resource_name
= Vinvocation_name
;
3823 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3824 if (EQ (display
, Qunbound
))
3826 dpyinfo
= check_x_display_info (display
);
3828 kb
= dpyinfo
->kboard
;
3830 kb
= &the_only_kboard
;
3833 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3835 && ! EQ (name
, Qunbound
)
3837 error ("Invalid frame name--not a string or nil");
3840 Vx_resource_name
= name
;
3842 /* See if parent window is specified. */
3843 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3844 if (EQ (parent
, Qunbound
))
3846 if (! NILP (parent
))
3847 CHECK_NUMBER (parent
, 0);
3849 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3850 /* No need to protect DISPLAY because that's not used after passing
3851 it to make_frame_without_minibuffer. */
3853 GCPRO4 (parms
, parent
, name
, frame
);
3854 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3856 if (EQ (tem
, Qnone
) || NILP (tem
))
3857 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3858 else if (EQ (tem
, Qonly
))
3860 f
= make_minibuffer_frame ();
3861 minibuffer_only
= 1;
3863 else if (WINDOWP (tem
))
3864 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3868 XSETFRAME (frame
, f
);
3870 /* Note that X Windows does support scroll bars. */
3871 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3873 f
->output_method
= output_x_window
;
3874 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3875 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3876 f
->output_data
.x
->icon_bitmap
= -1;
3877 f
->output_data
.x
->fontset
= -1;
3878 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3879 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3882 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3884 if (! STRINGP (f
->icon_name
))
3885 f
->icon_name
= Qnil
;
3887 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3889 FRAME_KBOARD (f
) = kb
;
3892 /* These colors will be set anyway later, but it's important
3893 to get the color reference counts right, so initialize them! */
3896 struct gcpro gcpro1
;
3898 black
= build_string ("black");
3900 f
->output_data
.x
->foreground_pixel
3901 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3902 f
->output_data
.x
->background_pixel
3903 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3904 f
->output_data
.x
->cursor_pixel
3905 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3906 f
->output_data
.x
->cursor_foreground_pixel
3907 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3908 f
->output_data
.x
->border_pixel
3909 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3910 f
->output_data
.x
->mouse_pixel
3911 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3915 /* Specify the parent under which to make this X window. */
3919 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3920 f
->output_data
.x
->explicit_parent
= 1;
3924 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3925 f
->output_data
.x
->explicit_parent
= 0;
3928 /* Set the name; the functions to which we pass f expect the name to
3930 if (EQ (name
, Qunbound
) || NILP (name
))
3932 f
->name
= build_string (dpyinfo
->x_id_name
);
3933 f
->explicit_name
= 0;
3938 f
->explicit_name
= 1;
3939 /* use the frame's title when getting resources for this frame. */
3940 specbind (Qx_resource_name
, name
);
3943 /* Extract the window parameters from the supplied values
3944 that are needed to determine window geometry. */
3948 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3951 /* First, try whatever font the caller has specified. */
3954 tem
= Fquery_fontset (font
, Qnil
);
3956 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3958 font
= x_new_font (f
, XSTRING (font
)->data
);
3961 /* Try out a font which we hope has bold and italic variations. */
3962 if (!STRINGP (font
))
3963 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3964 if (!STRINGP (font
))
3965 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3966 if (! STRINGP (font
))
3967 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3968 if (! STRINGP (font
))
3969 /* This was formerly the first thing tried, but it finds too many fonts
3970 and takes too long. */
3971 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3972 /* If those didn't work, look for something which will at least work. */
3973 if (! STRINGP (font
))
3974 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3976 if (! STRINGP (font
))
3977 font
= build_string ("fixed");
3979 x_default_parameter (f
, parms
, Qfont
, font
,
3980 "font", "Font", RES_TYPE_STRING
);
3984 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3985 whereby it fails to get any font. */
3986 xlwmenu_default_font
= f
->output_data
.x
->font
;
3989 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3990 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3992 /* This defaults to 2 in order to match xterm. We recognize either
3993 internalBorderWidth or internalBorder (which is what xterm calls
3995 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3999 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4000 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4001 if (! EQ (value
, Qunbound
))
4002 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4005 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4006 "internalBorderWidth", "internalBorderWidth",
4008 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4009 "verticalScrollBars", "ScrollBars",
4012 /* Also do the stuff which must be set before the window exists. */
4013 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4014 "foreground", "Foreground", RES_TYPE_STRING
);
4015 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4016 "background", "Background", RES_TYPE_STRING
);
4017 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4018 "pointerColor", "Foreground", RES_TYPE_STRING
);
4019 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4020 "cursorColor", "Foreground", RES_TYPE_STRING
);
4021 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4022 "borderColor", "BorderColor", RES_TYPE_STRING
);
4023 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4024 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4026 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4027 "scrollBarForeground",
4028 "ScrollBarForeground", 1);
4029 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4030 "scrollBarBackground",
4031 "ScrollBarBackground", 0);
4033 /* Init faces before x_default_parameter is called for scroll-bar
4034 parameters because that function calls x_set_scroll_bar_width,
4035 which calls change_frame_size, which calls Fset_window_buffer,
4036 which runs hooks, which call Fvertical_motion. At the end, we
4037 end up in init_iterator with a null face cache, which should not
4039 init_frame_faces (f
);
4041 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4042 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4043 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4044 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4045 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4046 "bufferPredicate", "BufferPredicate",
4048 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4049 "title", "Title", RES_TYPE_STRING
);
4051 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4052 window_prompting
= x_figure_window_size (f
, parms
);
4054 if (window_prompting
& XNegative
)
4056 if (window_prompting
& YNegative
)
4057 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4059 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4063 if (window_prompting
& YNegative
)
4064 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4066 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4069 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4071 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4072 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4074 /* Create the X widget or window. Add the tool-bar height to the
4075 initial frame height so that the user gets a text display area of
4076 the size he specified with -g or via .Xdefaults. Later changes
4077 of the tool-bar height don't change the frame size. This is done
4078 so that users can create tall Emacs frames without having to
4079 guess how tall the tool-bar will get. */
4080 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4082 #ifdef USE_X_TOOLKIT
4083 x_window (f
, window_prompting
, minibuffer_only
);
4091 /* Now consider the frame official. */
4092 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4093 Vframe_list
= Fcons (frame
, Vframe_list
);
4095 /* We need to do this after creating the X window, so that the
4096 icon-creation functions can say whose icon they're describing. */
4097 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4098 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4100 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4101 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4102 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4103 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4104 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4105 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4106 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4107 "scrollBarWidth", "ScrollBarWidth",
4110 /* Dimensions, especially f->height, must be done via change_frame_size.
4111 Change will not be effected unless different from the current
4116 SET_FRAME_WIDTH (f
, 0);
4117 change_frame_size (f
, height
, width
, 1, 0, 0);
4119 /* Set up faces after all frame parameters are known. */
4120 call1 (Qface_set_after_frame_default
, frame
);
4122 #ifdef USE_X_TOOLKIT
4123 /* Create the menu bar. */
4124 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4126 /* If this signals an error, we haven't set size hints for the
4127 frame and we didn't make it visible. */
4128 initialize_frame_menubar (f
);
4130 /* This is a no-op, except under Motif where it arranges the
4131 main window for the widgets on it. */
4132 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4133 f
->output_data
.x
->menubar_widget
,
4134 f
->output_data
.x
->edit_widget
);
4136 #endif /* USE_X_TOOLKIT */
4138 /* Tell the server what size and position, etc, we want, and how
4139 badly we want them. This should be done after we have the menu
4140 bar so that its size can be taken into account. */
4142 x_wm_set_size_hint (f
, window_prompting
, 0);
4145 /* Make the window appear on the frame and enable display, unless
4146 the caller says not to. However, with explicit parent, Emacs
4147 cannot control visibility, so don't try. */
4148 if (! f
->output_data
.x
->explicit_parent
)
4150 Lisp_Object visibility
;
4152 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4154 if (EQ (visibility
, Qunbound
))
4157 if (EQ (visibility
, Qicon
))
4158 x_iconify_frame (f
);
4159 else if (! NILP (visibility
))
4160 x_make_frame_visible (f
);
4162 /* Must have been Qnil. */
4167 return unbind_to (count
, frame
);
4170 /* FRAME is used only to get a handle on the X display. We don't pass the
4171 display info directly because we're called from frame.c, which doesn't
4172 know about that structure. */
4175 x_get_focus_frame (frame
)
4176 struct frame
*frame
;
4178 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4180 if (! dpyinfo
->x_focus_frame
)
4183 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4188 /* In certain situations, when the window manager follows a
4189 click-to-focus policy, there seems to be no way around calling
4190 XSetInputFocus to give another frame the input focus .
4192 In an ideal world, XSetInputFocus should generally be avoided so
4193 that applications don't interfere with the window manager's focus
4194 policy. But I think it's okay to use when it's clearly done
4195 following a user-command. */
4197 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4198 "Set the input focus to FRAME.\n\
4199 FRAME nil means use the selected frame.")
4203 struct frame
*f
= check_x_frame (frame
);
4204 Display
*dpy
= FRAME_X_DISPLAY (f
);
4208 count
= x_catch_errors (dpy
);
4209 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4210 RevertToParent
, CurrentTime
);
4211 x_uncatch_errors (dpy
, count
);
4218 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4219 "Internal function called by `color-defined-p', which see.")
4221 Lisp_Object color
, frame
;
4224 FRAME_PTR f
= check_x_frame (frame
);
4226 CHECK_STRING (color
, 1);
4228 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4234 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4235 "Internal function called by `color-values', which see.")
4237 Lisp_Object color
, frame
;
4240 FRAME_PTR f
= check_x_frame (frame
);
4242 CHECK_STRING (color
, 1);
4244 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4248 rgb
[0] = make_number (foo
.red
);
4249 rgb
[1] = make_number (foo
.green
);
4250 rgb
[2] = make_number (foo
.blue
);
4251 return Flist (3, rgb
);
4257 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4258 "Internal function called by `display-color-p', which see.")
4260 Lisp_Object display
;
4262 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4264 if (dpyinfo
->n_planes
<= 2)
4267 switch (dpyinfo
->visual
->class)
4280 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4282 "Return t if the X display supports shades of gray.\n\
4283 Note that color displays do support shades of gray.\n\
4284 The optional argument DISPLAY specifies which display to ask about.\n\
4285 DISPLAY should be either a frame or a display name (a string).\n\
4286 If omitted or nil, that stands for the selected frame's display.")
4288 Lisp_Object display
;
4290 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4292 if (dpyinfo
->n_planes
<= 1)
4295 switch (dpyinfo
->visual
->class)
4310 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4312 "Returns the width in pixels of the X display DISPLAY.\n\
4313 The optional argument DISPLAY specifies which display to ask about.\n\
4314 DISPLAY should be either a frame or a display name (a string).\n\
4315 If omitted or nil, that stands for the selected frame's display.")
4317 Lisp_Object display
;
4319 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4321 return make_number (dpyinfo
->width
);
4324 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4325 Sx_display_pixel_height
, 0, 1, 0,
4326 "Returns the height in pixels of the X display DISPLAY.\n\
4327 The optional argument DISPLAY specifies which display to ask about.\n\
4328 DISPLAY should be either a frame or a display name (a string).\n\
4329 If omitted or nil, that stands for the selected frame's display.")
4331 Lisp_Object display
;
4333 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4335 return make_number (dpyinfo
->height
);
4338 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4340 "Returns the number of bitplanes of the X display DISPLAY.\n\
4341 The optional argument DISPLAY specifies which display to ask about.\n\
4342 DISPLAY should be either a frame or a display name (a string).\n\
4343 If omitted or nil, that stands for the selected frame's display.")
4345 Lisp_Object display
;
4347 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4349 return make_number (dpyinfo
->n_planes
);
4352 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4354 "Returns the number of color cells of the X display DISPLAY.\n\
4355 The optional argument DISPLAY specifies which display to ask about.\n\
4356 DISPLAY should be either a frame or a display name (a string).\n\
4357 If omitted or nil, that stands for the selected frame's display.")
4359 Lisp_Object display
;
4361 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4363 return make_number (DisplayCells (dpyinfo
->display
,
4364 XScreenNumberOfScreen (dpyinfo
->screen
)));
4367 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4368 Sx_server_max_request_size
,
4370 "Returns the maximum request size of the X server of display DISPLAY.\n\
4371 The optional argument DISPLAY specifies which display to ask about.\n\
4372 DISPLAY should be either a frame or a display name (a string).\n\
4373 If omitted or nil, that stands for the selected frame's display.")
4375 Lisp_Object display
;
4377 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4379 return make_number (MAXREQUEST (dpyinfo
->display
));
4382 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4383 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4384 The optional argument DISPLAY specifies which display to ask about.\n\
4385 DISPLAY should be either a frame or a display name (a string).\n\
4386 If omitted or nil, that stands for the selected frame's display.")
4388 Lisp_Object display
;
4390 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4391 char *vendor
= ServerVendor (dpyinfo
->display
);
4393 if (! vendor
) vendor
= "";
4394 return build_string (vendor
);
4397 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4398 "Returns the version numbers of the X server of display DISPLAY.\n\
4399 The value is a list of three integers: the major and minor\n\
4400 version numbers of the X Protocol in use, and the vendor-specific release\n\
4401 number. See also the function `x-server-vendor'.\n\n\
4402 The optional argument DISPLAY specifies which display to ask about.\n\
4403 DISPLAY should be either a frame or a display name (a string).\n\
4404 If omitted or nil, that stands for the selected frame's display.")
4406 Lisp_Object display
;
4408 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4409 Display
*dpy
= dpyinfo
->display
;
4411 return Fcons (make_number (ProtocolVersion (dpy
)),
4412 Fcons (make_number (ProtocolRevision (dpy
)),
4413 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4416 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4417 "Returns the number of screens on the X server of display DISPLAY.\n\
4418 The optional argument DISPLAY specifies which display to ask about.\n\
4419 DISPLAY should be either a frame or a display name (a string).\n\
4420 If omitted or nil, that stands for the selected frame's display.")
4422 Lisp_Object display
;
4424 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4426 return make_number (ScreenCount (dpyinfo
->display
));
4429 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4430 "Returns the height in millimeters of the X display DISPLAY.\n\
4431 The optional argument DISPLAY specifies which display to ask about.\n\
4432 DISPLAY should be either a frame or a display name (a string).\n\
4433 If omitted or nil, that stands for the selected frame's display.")
4435 Lisp_Object display
;
4437 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4439 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4442 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4443 "Returns the width in millimeters of the X display DISPLAY.\n\
4444 The optional argument DISPLAY specifies which display to ask about.\n\
4445 DISPLAY should be either a frame or a display name (a string).\n\
4446 If omitted or nil, that stands for the selected frame's display.")
4448 Lisp_Object display
;
4450 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4452 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4455 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4456 Sx_display_backing_store
, 0, 1, 0,
4457 "Returns an indication of whether X display DISPLAY does backing store.\n\
4458 The value may be `always', `when-mapped', or `not-useful'.\n\
4459 The optional argument DISPLAY specifies which display to ask about.\n\
4460 DISPLAY should be either a frame or a display name (a string).\n\
4461 If omitted or nil, that stands for the selected frame's display.")
4463 Lisp_Object display
;
4465 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4467 switch (DoesBackingStore (dpyinfo
->screen
))
4470 return intern ("always");
4473 return intern ("when-mapped");
4476 return intern ("not-useful");
4479 error ("Strange value for BackingStore parameter of screen");
4483 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4484 Sx_display_visual_class
, 0, 1, 0,
4485 "Returns the visual class of the X display DISPLAY.\n\
4486 The value is one of the symbols `static-gray', `gray-scale',\n\
4487 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4488 The optional argument DISPLAY specifies which display to ask about.\n\
4489 DISPLAY should be either a frame or a display name (a string).\n\
4490 If omitted or nil, that stands for the selected frame's display.")
4492 Lisp_Object display
;
4494 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4496 switch (dpyinfo
->visual
->class)
4498 case StaticGray
: return (intern ("static-gray"));
4499 case GrayScale
: return (intern ("gray-scale"));
4500 case StaticColor
: return (intern ("static-color"));
4501 case PseudoColor
: return (intern ("pseudo-color"));
4502 case TrueColor
: return (intern ("true-color"));
4503 case DirectColor
: return (intern ("direct-color"));
4505 error ("Display has an unknown visual class");
4509 DEFUN ("x-display-save-under", Fx_display_save_under
,
4510 Sx_display_save_under
, 0, 1, 0,
4511 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4512 The optional argument DISPLAY specifies which display to ask about.\n\
4513 DISPLAY should be either a frame or a display name (a string).\n\
4514 If omitted or nil, that stands for the selected frame's display.")
4516 Lisp_Object display
;
4518 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4520 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4528 register struct frame
*f
;
4530 return PIXEL_WIDTH (f
);
4535 register struct frame
*f
;
4537 return PIXEL_HEIGHT (f
);
4542 register struct frame
*f
;
4544 return FONT_WIDTH (f
->output_data
.x
->font
);
4549 register struct frame
*f
;
4551 return f
->output_data
.x
->line_height
;
4556 register struct frame
*f
;
4558 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4563 /************************************************************************
4565 ************************************************************************/
4568 /* Mapping visual names to visuals. */
4570 static struct visual_class
4577 {"StaticGray", StaticGray
},
4578 {"GrayScale", GrayScale
},
4579 {"StaticColor", StaticColor
},
4580 {"PseudoColor", PseudoColor
},
4581 {"TrueColor", TrueColor
},
4582 {"DirectColor", DirectColor
},
4587 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4589 /* Value is the screen number of screen SCR. This is a substitute for
4590 the X function with the same name when that doesn't exist. */
4593 XScreenNumberOfScreen (scr
)
4594 register Screen
*scr
;
4596 Display
*dpy
= scr
->display
;
4599 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4600 if (scr
== dpy
->screens
[i
])
4606 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4609 /* Select the visual that should be used on display DPYINFO. Set
4610 members of DPYINFO appropriately. Called from x_term_init. */
4613 select_visual (dpyinfo
)
4614 struct x_display_info
*dpyinfo
;
4616 Display
*dpy
= dpyinfo
->display
;
4617 Screen
*screen
= dpyinfo
->screen
;
4620 /* See if a visual is specified. */
4621 value
= display_x_get_resource (dpyinfo
,
4622 build_string ("visualClass"),
4623 build_string ("VisualClass"),
4625 if (STRINGP (value
))
4627 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4628 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4629 depth, a decimal number. NAME is compared with case ignored. */
4630 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4635 strcpy (s
, XSTRING (value
)->data
);
4636 dash
= index (s
, '-');
4639 dpyinfo
->n_planes
= atoi (dash
+ 1);
4643 /* We won't find a matching visual with depth 0, so that
4644 an error will be printed below. */
4645 dpyinfo
->n_planes
= 0;
4647 /* Determine the visual class. */
4648 for (i
= 0; visual_classes
[i
].name
; ++i
)
4649 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4651 class = visual_classes
[i
].class;
4655 /* Look up a matching visual for the specified class. */
4657 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4658 dpyinfo
->n_planes
, class, &vinfo
))
4659 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4661 dpyinfo
->visual
= vinfo
.visual
;
4666 XVisualInfo
*vinfo
, vinfo_template
;
4668 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4671 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4673 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4675 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4676 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4677 &vinfo_template
, &n_visuals
);
4679 fatal ("Can't get proper X visual info");
4681 dpyinfo
->n_planes
= vinfo
->depth
;
4682 XFree ((char *) vinfo
);
4687 /* Return the X display structure for the display named NAME.
4688 Open a new connection if necessary. */
4690 struct x_display_info
*
4691 x_display_info_for_name (name
)
4695 struct x_display_info
*dpyinfo
;
4697 CHECK_STRING (name
, 0);
4699 if (! EQ (Vwindow_system
, intern ("x")))
4700 error ("Not using X Windows");
4702 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4704 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4707 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4712 /* Use this general default value to start with. */
4713 Vx_resource_name
= Vinvocation_name
;
4715 validate_x_resource_name ();
4717 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4718 (char *) XSTRING (Vx_resource_name
)->data
);
4721 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4724 XSETFASTINT (Vwindow_system_version
, 11);
4730 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4731 1, 3, 0, "Open a connection to an X server.\n\
4732 DISPLAY is the name of the display to connect to.\n\
4733 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4734 If the optional third arg MUST-SUCCEED is non-nil,\n\
4735 terminate Emacs if we can't open the connection.")
4736 (display
, xrm_string
, must_succeed
)
4737 Lisp_Object display
, xrm_string
, must_succeed
;
4739 unsigned char *xrm_option
;
4740 struct x_display_info
*dpyinfo
;
4742 CHECK_STRING (display
, 0);
4743 if (! NILP (xrm_string
))
4744 CHECK_STRING (xrm_string
, 1);
4746 if (! EQ (Vwindow_system
, intern ("x")))
4747 error ("Not using X Windows");
4749 if (! NILP (xrm_string
))
4750 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4752 xrm_option
= (unsigned char *) 0;
4754 validate_x_resource_name ();
4756 /* This is what opens the connection and sets x_current_display.
4757 This also initializes many symbols, such as those used for input. */
4758 dpyinfo
= x_term_init (display
, xrm_option
,
4759 (char *) XSTRING (Vx_resource_name
)->data
);
4763 if (!NILP (must_succeed
))
4764 fatal ("Cannot connect to X server %s.\n\
4765 Check the DISPLAY environment variable or use `-d'.\n\
4766 Also use the `xhost' program to verify that it is set to permit\n\
4767 connections from your machine.\n",
4768 XSTRING (display
)->data
);
4770 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4775 XSETFASTINT (Vwindow_system_version
, 11);
4779 DEFUN ("x-close-connection", Fx_close_connection
,
4780 Sx_close_connection
, 1, 1, 0,
4781 "Close the connection to DISPLAY's X server.\n\
4782 For DISPLAY, specify either a frame or a display name (a string).\n\
4783 If DISPLAY is nil, that stands for the selected frame's display.")
4785 Lisp_Object display
;
4787 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4790 if (dpyinfo
->reference_count
> 0)
4791 error ("Display still has frames on it");
4794 /* Free the fonts in the font table. */
4795 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4796 if (dpyinfo
->font_table
[i
].name
)
4798 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4799 xfree (dpyinfo
->font_table
[i
].full_name
);
4800 xfree (dpyinfo
->font_table
[i
].name
);
4801 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4804 x_destroy_all_bitmaps (dpyinfo
);
4805 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4807 #ifdef USE_X_TOOLKIT
4808 XtCloseDisplay (dpyinfo
->display
);
4810 XCloseDisplay (dpyinfo
->display
);
4813 x_delete_display (dpyinfo
);
4819 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4820 "Return the list of display names that Emacs has connections to.")
4823 Lisp_Object tail
, result
;
4826 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4827 result
= Fcons (XCAR (XCAR (tail
)), result
);
4832 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4833 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4834 If ON is nil, allow buffering of requests.\n\
4835 Turning on synchronization prohibits the Xlib routines from buffering\n\
4836 requests and seriously degrades performance, but makes debugging much\n\
4838 The optional second argument DISPLAY specifies which display to act on.\n\
4839 DISPLAY should be either a frame or a display name (a string).\n\
4840 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4842 Lisp_Object display
, on
;
4844 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4846 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4851 /* Wait for responses to all X commands issued so far for frame F. */
4858 XSync (FRAME_X_DISPLAY (f
), False
);
4863 /***********************************************************************
4865 ***********************************************************************/
4867 /* Value is the number of elements of vector VECTOR. */
4869 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4871 /* List of supported image types. Use define_image_type to add new
4872 types. Use lookup_image_type to find a type for a given symbol. */
4874 static struct image_type
*image_types
;
4876 /* A list of symbols, one for each supported image type. */
4878 Lisp_Object Vimage_types
;
4880 /* The symbol `image' which is the car of the lists used to represent
4883 extern Lisp_Object Qimage
;
4885 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4891 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
4892 extern Lisp_Object QCdata
;
4893 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
4894 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
4895 Lisp_Object QCindex
;
4897 /* Other symbols. */
4899 Lisp_Object Qlaplace
;
4901 /* Time in seconds after which images should be removed from the cache
4902 if not displayed. */
4904 Lisp_Object Vimage_cache_eviction_delay
;
4906 /* Function prototypes. */
4908 static void define_image_type
P_ ((struct image_type
*type
));
4909 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
4910 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
4911 static void x_laplace
P_ ((struct frame
*, struct image
*));
4912 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
4916 /* Define a new image type from TYPE. This adds a copy of TYPE to
4917 image_types and adds the symbol *TYPE->type to Vimage_types. */
4920 define_image_type (type
)
4921 struct image_type
*type
;
4923 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4924 The initialized data segment is read-only. */
4925 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
4926 bcopy (type
, p
, sizeof *p
);
4927 p
->next
= image_types
;
4929 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
4933 /* Look up image type SYMBOL, and return a pointer to its image_type
4934 structure. Value is null if SYMBOL is not a known image type. */
4936 static INLINE
struct image_type
*
4937 lookup_image_type (symbol
)
4940 struct image_type
*type
;
4942 for (type
= image_types
; type
; type
= type
->next
)
4943 if (EQ (symbol
, *type
->type
))
4950 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4951 valid image specification is a list whose car is the symbol
4952 `image', and whose rest is a property list. The property list must
4953 contain a value for key `:type'. That value must be the name of a
4954 supported image type. The rest of the property list depends on the
4958 valid_image_p (object
)
4963 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
4965 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
4966 struct image_type
*type
= lookup_image_type (symbol
);
4969 valid_p
= type
->valid_p (object
);
4976 /* Log error message with format string FORMAT and argument ARG.
4977 Signaling an error, e.g. when an image cannot be loaded, is not a
4978 good idea because this would interrupt redisplay, and the error
4979 message display would lead to another redisplay. This function
4980 therefore simply displays a message. */
4983 image_error (format
, arg1
, arg2
)
4985 Lisp_Object arg1
, arg2
;
4987 add_to_log (format
, arg1
, arg2
);
4992 /***********************************************************************
4993 Image specifications
4994 ***********************************************************************/
4996 enum image_value_type
4998 IMAGE_DONT_CHECK_VALUE_TYPE
,
5001 IMAGE_POSITIVE_INTEGER_VALUE
,
5002 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5003 IMAGE_INTEGER_VALUE
,
5004 IMAGE_FUNCTION_VALUE
,
5009 /* Structure used when parsing image specifications. */
5011 struct image_keyword
5013 /* Name of keyword. */
5016 /* The type of value allowed. */
5017 enum image_value_type type
;
5019 /* Non-zero means key must be present. */
5022 /* Used to recognize duplicate keywords in a property list. */
5025 /* The value that was found. */
5030 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5032 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5035 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5036 has the format (image KEYWORD VALUE ...). One of the keyword/
5037 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5038 image_keywords structures of size NKEYWORDS describing other
5039 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5042 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5044 struct image_keyword
*keywords
;
5051 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5054 plist
= XCDR (spec
);
5055 while (CONSP (plist
))
5057 Lisp_Object key
, value
;
5059 /* First element of a pair must be a symbol. */
5061 plist
= XCDR (plist
);
5065 /* There must follow a value. */
5068 value
= XCAR (plist
);
5069 plist
= XCDR (plist
);
5071 /* Find key in KEYWORDS. Error if not found. */
5072 for (i
= 0; i
< nkeywords
; ++i
)
5073 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5079 /* Record that we recognized the keyword. If a keywords
5080 was found more than once, it's an error. */
5081 keywords
[i
].value
= value
;
5082 ++keywords
[i
].count
;
5084 if (keywords
[i
].count
> 1)
5087 /* Check type of value against allowed type. */
5088 switch (keywords
[i
].type
)
5090 case IMAGE_STRING_VALUE
:
5091 if (!STRINGP (value
))
5095 case IMAGE_SYMBOL_VALUE
:
5096 if (!SYMBOLP (value
))
5100 case IMAGE_POSITIVE_INTEGER_VALUE
:
5101 if (!INTEGERP (value
) || XINT (value
) <= 0)
5105 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5106 if (!INTEGERP (value
) || XINT (value
) < 0)
5110 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5113 case IMAGE_FUNCTION_VALUE
:
5114 value
= indirect_function (value
);
5116 || COMPILEDP (value
)
5117 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5121 case IMAGE_NUMBER_VALUE
:
5122 if (!INTEGERP (value
) && !FLOATP (value
))
5126 case IMAGE_INTEGER_VALUE
:
5127 if (!INTEGERP (value
))
5131 case IMAGE_BOOL_VALUE
:
5132 if (!NILP (value
) && !EQ (value
, Qt
))
5141 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5145 /* Check that all mandatory fields are present. */
5146 for (i
= 0; i
< nkeywords
; ++i
)
5147 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5150 return NILP (plist
);
5154 /* Return the value of KEY in image specification SPEC. Value is nil
5155 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5156 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5159 image_spec_value (spec
, key
, found
)
5160 Lisp_Object spec
, key
;
5165 xassert (valid_image_p (spec
));
5167 for (tail
= XCDR (spec
);
5168 CONSP (tail
) && CONSP (XCDR (tail
));
5169 tail
= XCDR (XCDR (tail
)))
5171 if (EQ (XCAR (tail
), key
))
5175 return XCAR (XCDR (tail
));
5187 /***********************************************************************
5188 Image type independent image structures
5189 ***********************************************************************/
5191 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5192 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5195 /* Allocate and return a new image structure for image specification
5196 SPEC. SPEC has a hash value of HASH. */
5198 static struct image
*
5199 make_image (spec
, hash
)
5203 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5205 xassert (valid_image_p (spec
));
5206 bzero (img
, sizeof *img
);
5207 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5208 xassert (img
->type
!= NULL
);
5210 img
->data
.lisp_val
= Qnil
;
5211 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5217 /* Free image IMG which was used on frame F, including its resources. */
5226 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5228 /* Remove IMG from the hash table of its cache. */
5230 img
->prev
->next
= img
->next
;
5232 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5235 img
->next
->prev
= img
->prev
;
5237 c
->images
[img
->id
] = NULL
;
5239 /* Free resources, then free IMG. */
5240 img
->type
->free (f
, img
);
5246 /* Prepare image IMG for display on frame F. Must be called before
5247 drawing an image. */
5250 prepare_image_for_display (f
, img
)
5256 /* We're about to display IMG, so set its timestamp to `now'. */
5258 img
->timestamp
= EMACS_SECS (t
);
5260 /* If IMG doesn't have a pixmap yet, load it now, using the image
5261 type dependent loader function. */
5262 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5263 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5268 /***********************************************************************
5269 Helper functions for X image types
5270 ***********************************************************************/
5272 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5273 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5275 Lisp_Object color_name
,
5276 unsigned long dflt
));
5278 /* Free X resources of image IMG which is used on frame F. */
5281 x_clear_image (f
, img
)
5288 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5296 x_free_colors (f
, img
->colors
, img
->ncolors
);
5299 xfree (img
->colors
);
5306 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5307 cannot be allocated, use DFLT. Add a newly allocated color to
5308 IMG->colors, so that it can be freed again. Value is the pixel
5311 static unsigned long
5312 x_alloc_image_color (f
, img
, color_name
, dflt
)
5315 Lisp_Object color_name
;
5319 unsigned long result
;
5321 xassert (STRINGP (color_name
));
5323 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5325 /* This isn't called frequently so we get away with simply
5326 reallocating the color vector to the needed size, here. */
5329 (unsigned long *) xrealloc (img
->colors
,
5330 img
->ncolors
* sizeof *img
->colors
);
5331 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5332 result
= color
.pixel
;
5342 /***********************************************************************
5344 ***********************************************************************/
5346 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5349 /* Return a new, initialized image cache that is allocated from the
5350 heap. Call free_image_cache to free an image cache. */
5352 struct image_cache
*
5355 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5358 bzero (c
, sizeof *c
);
5360 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5361 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5362 c
->buckets
= (struct image
**) xmalloc (size
);
5363 bzero (c
->buckets
, size
);
5368 /* Free image cache of frame F. Be aware that X frames share images
5372 free_image_cache (f
)
5375 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5380 /* Cache should not be referenced by any frame when freed. */
5381 xassert (c
->refcount
== 0);
5383 for (i
= 0; i
< c
->used
; ++i
)
5384 free_image (f
, c
->images
[i
]);
5388 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5393 /* Clear image cache of frame F. FORCE_P non-zero means free all
5394 images. FORCE_P zero means clear only images that haven't been
5395 displayed for some time. Should be called from time to time to
5396 reduce the number of loaded images. If image-eviction-seconds is
5397 non-nil, this frees images in the cache which weren't displayed for
5398 at least that many seconds. */
5401 clear_image_cache (f
, force_p
)
5405 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5407 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5411 int i
, any_freed_p
= 0;
5414 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5416 for (i
= 0; i
< c
->used
; ++i
)
5418 struct image
*img
= c
->images
[i
];
5421 || (img
->timestamp
> old
)))
5423 free_image (f
, img
);
5428 /* We may be clearing the image cache because, for example,
5429 Emacs was iconified for a longer period of time. In that
5430 case, current matrices may still contain references to
5431 images freed above. So, clear these matrices. */
5434 clear_current_matrices (f
);
5435 ++windows_or_buffers_changed
;
5441 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5443 "Clear the image cache of FRAME.\n\
5444 FRAME nil or omitted means use the selected frame.\n\
5445 FRAME t means clear the image caches of all frames.")
5453 FOR_EACH_FRAME (tail
, frame
)
5454 if (FRAME_X_P (XFRAME (frame
)))
5455 clear_image_cache (XFRAME (frame
), 1);
5458 clear_image_cache (check_x_frame (frame
), 1);
5464 /* Return the id of image with Lisp specification SPEC on frame F.
5465 SPEC must be a valid Lisp image specification (see valid_image_p). */
5468 lookup_image (f
, spec
)
5472 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5476 struct gcpro gcpro1
;
5479 /* F must be a window-system frame, and SPEC must be a valid image
5481 xassert (FRAME_WINDOW_P (f
));
5482 xassert (valid_image_p (spec
));
5486 /* Look up SPEC in the hash table of the image cache. */
5487 hash
= sxhash (spec
, 0);
5488 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5490 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5491 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5494 /* If not found, create a new image and cache it. */
5497 img
= make_image (spec
, hash
);
5498 cache_image (f
, img
);
5499 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5500 xassert (!interrupt_input_blocked
);
5502 /* If we can't load the image, and we don't have a width and
5503 height, use some arbitrary width and height so that we can
5504 draw a rectangle for it. */
5505 if (img
->load_failed_p
)
5509 value
= image_spec_value (spec
, QCwidth
, NULL
);
5510 img
->width
= (INTEGERP (value
)
5511 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5512 value
= image_spec_value (spec
, QCheight
, NULL
);
5513 img
->height
= (INTEGERP (value
)
5514 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5518 /* Handle image type independent image attributes
5519 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
5520 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
5523 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5524 if (INTEGERP (ascent
))
5525 img
->ascent
= XFASTINT (ascent
);
5527 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5528 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5529 img
->margin
= XFASTINT (margin
);
5531 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5532 if (INTEGERP (relief
))
5534 img
->relief
= XINT (relief
);
5535 img
->margin
+= abs (img
->relief
);
5538 /* Should we apply a Laplace edge-detection algorithm? */
5539 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5540 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
5543 /* Should we built a mask heuristically? */
5544 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5545 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
5546 x_build_heuristic_mask (f
, img
, heuristic_mask
);
5550 /* We're using IMG, so set its timestamp to `now'. */
5551 EMACS_GET_TIME (now
);
5552 img
->timestamp
= EMACS_SECS (now
);
5556 /* Value is the image id. */
5561 /* Cache image IMG in the image cache of frame F. */
5564 cache_image (f
, img
)
5568 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5571 /* Find a free slot in c->images. */
5572 for (i
= 0; i
< c
->used
; ++i
)
5573 if (c
->images
[i
] == NULL
)
5576 /* If no free slot found, maybe enlarge c->images. */
5577 if (i
== c
->used
&& c
->used
== c
->size
)
5580 c
->images
= (struct image
**) xrealloc (c
->images
,
5581 c
->size
* sizeof *c
->images
);
5584 /* Add IMG to c->images, and assign IMG an id. */
5590 /* Add IMG to the cache's hash table. */
5591 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5592 img
->next
= c
->buckets
[i
];
5594 img
->next
->prev
= img
;
5596 c
->buckets
[i
] = img
;
5600 /* Call FN on every image in the image cache of frame F. Used to mark
5601 Lisp Objects in the image cache. */
5604 forall_images_in_image_cache (f
, fn
)
5606 void (*fn
) P_ ((struct image
*img
));
5608 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5610 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5614 for (i
= 0; i
< c
->used
; ++i
)
5623 /***********************************************************************
5625 ***********************************************************************/
5627 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5628 XImage
**, Pixmap
*));
5629 static void x_destroy_x_image
P_ ((XImage
*));
5630 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5633 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5634 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5635 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5636 via xmalloc. Print error messages via image_error if an error
5637 occurs. Value is non-zero if successful. */
5640 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5642 int width
, height
, depth
;
5646 Display
*display
= FRAME_X_DISPLAY (f
);
5647 Screen
*screen
= FRAME_X_SCREEN (f
);
5648 Window window
= FRAME_X_WINDOW (f
);
5650 xassert (interrupt_input_blocked
);
5653 depth
= DefaultDepthOfScreen (screen
);
5654 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5655 depth
, ZPixmap
, 0, NULL
, width
, height
,
5656 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5659 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5663 /* Allocate image raster. */
5664 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5666 /* Allocate a pixmap of the same size. */
5667 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5670 x_destroy_x_image (*ximg
);
5672 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
5680 /* Destroy XImage XIMG. Free XIMG->data. */
5683 x_destroy_x_image (ximg
)
5686 xassert (interrupt_input_blocked
);
5691 XDestroyImage (ximg
);
5696 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5697 are width and height of both the image and pixmap. */
5700 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
5707 xassert (interrupt_input_blocked
);
5708 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
5709 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
5710 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
5715 /***********************************************************************
5717 ***********************************************************************/
5719 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
5721 /* Find image file FILE. Look in data-directory, then
5722 x-bitmap-file-path. Value is the full name of the file found, or
5723 nil if not found. */
5726 x_find_image_file (file
)
5729 Lisp_Object file_found
, search_path
;
5730 struct gcpro gcpro1
, gcpro2
;
5734 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
5735 GCPRO2 (file_found
, search_path
);
5737 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5738 fd
= openp (search_path
, file
, "", &file_found
, 0);
5751 /***********************************************************************
5753 ***********************************************************************/
5755 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
5756 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
5758 static int xbm_image_p
P_ ((Lisp_Object object
));
5759 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
5763 /* Indices of image specification fields in xbm_format, below. */
5765 enum xbm_keyword_index
5782 /* Vector of image_keyword structures describing the format
5783 of valid XBM image specifications. */
5785 static struct image_keyword xbm_format
[XBM_LAST
] =
5787 {":type", IMAGE_SYMBOL_VALUE
, 1},
5788 {":file", IMAGE_STRING_VALUE
, 0},
5789 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5790 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5791 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5792 {":foreground", IMAGE_STRING_VALUE
, 0},
5793 {":background", IMAGE_STRING_VALUE
, 0},
5794 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
5795 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5796 {":relief", IMAGE_INTEGER_VALUE
, 0},
5797 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5798 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
5801 /* Structure describing the image type XBM. */
5803 static struct image_type xbm_type
=
5812 /* Tokens returned from xbm_scan. */
5821 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5822 A valid specification is a list starting with the symbol `image'
5823 The rest of the list is a property list which must contain an
5826 If the specification specifies a file to load, it must contain
5827 an entry `:file FILENAME' where FILENAME is a string.
5829 If the specification is for a bitmap loaded from memory it must
5830 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5831 WIDTH and HEIGHT are integers > 0. DATA may be:
5833 1. a string large enough to hold the bitmap data, i.e. it must
5834 have a size >= (WIDTH + 7) / 8 * HEIGHT
5836 2. a bool-vector of size >= WIDTH * HEIGHT
5838 3. a vector of strings or bool-vectors, one for each line of the
5841 Both the file and data forms may contain the additional entries
5842 `:background COLOR' and `:foreground COLOR'. If not present,
5843 foreground and background of the frame on which the image is
5844 displayed is used. */
5847 xbm_image_p (object
)
5850 struct image_keyword kw
[XBM_LAST
];
5852 bcopy (xbm_format
, kw
, sizeof kw
);
5853 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
5856 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
5858 if (kw
[XBM_FILE
].count
)
5860 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
5868 /* Entries for `:width', `:height' and `:data' must be present. */
5869 if (!kw
[XBM_WIDTH
].count
5870 || !kw
[XBM_HEIGHT
].count
5871 || !kw
[XBM_DATA
].count
)
5874 data
= kw
[XBM_DATA
].value
;
5875 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
5876 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
5878 /* Check type of data, and width and height against contents of
5884 /* Number of elements of the vector must be >= height. */
5885 if (XVECTOR (data
)->size
< height
)
5888 /* Each string or bool-vector in data must be large enough
5889 for one line of the image. */
5890 for (i
= 0; i
< height
; ++i
)
5892 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
5896 if (XSTRING (elt
)->size
5897 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
5900 else if (BOOL_VECTOR_P (elt
))
5902 if (XBOOL_VECTOR (elt
)->size
< width
)
5909 else if (STRINGP (data
))
5911 if (XSTRING (data
)->size
5912 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
5915 else if (BOOL_VECTOR_P (data
))
5917 if (XBOOL_VECTOR (data
)->size
< width
* height
)
5924 /* Baseline must be a value between 0 and 100 (a percentage). */
5925 if (kw
[XBM_ASCENT
].count
5926 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
5933 /* Scan a bitmap file. FP is the stream to read from. Value is
5934 either an enumerator from enum xbm_token, or a character for a
5935 single-character token, or 0 at end of file. If scanning an
5936 identifier, store the lexeme of the identifier in SVAL. If
5937 scanning a number, store its value in *IVAL. */
5940 xbm_scan (fp
, sval
, ival
)
5947 /* Skip white space. */
5948 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
5953 else if (isdigit (c
))
5955 int value
= 0, digit
;
5960 if (c
== 'x' || c
== 'X')
5962 while ((c
= fgetc (fp
)) != EOF
)
5966 else if (c
>= 'a' && c
<= 'f')
5967 digit
= c
- 'a' + 10;
5968 else if (c
>= 'A' && c
<= 'F')
5969 digit
= c
- 'A' + 10;
5972 value
= 16 * value
+ digit
;
5975 else if (isdigit (c
))
5978 while ((c
= fgetc (fp
)) != EOF
5980 value
= 8 * value
+ c
- '0';
5986 while ((c
= fgetc (fp
)) != EOF
5988 value
= 10 * value
+ c
- '0';
5996 else if (isalpha (c
) || c
== '_')
5999 while ((c
= fgetc (fp
)) != EOF
6000 && (isalnum (c
) || c
== '_'))
6012 /* Replacement for XReadBitmapFileData which isn't available under old
6013 X versions. FILE is the name of the bitmap file to read. Set
6014 *WIDTH and *HEIGHT to the width and height of the image. Return in
6015 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6019 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6021 int *width
, *height
;
6022 unsigned char **data
;
6025 char buffer
[BUFSIZ
];
6028 int bytes_per_line
, i
, nbytes
;
6034 LA1 = xbm_scan (fp, buffer, &value)
6036 #define expect(TOKEN) \
6037 if (LA1 != (TOKEN)) \
6042 #define expect_ident(IDENT) \
6043 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6048 fp
= fopen (file
, "r");
6052 *width
= *height
= -1;
6054 LA1
= xbm_scan (fp
, buffer
, &value
);
6056 /* Parse defines for width, height and hot-spots. */
6060 expect_ident ("define");
6061 expect (XBM_TK_IDENT
);
6063 if (LA1
== XBM_TK_NUMBER
);
6065 char *p
= strrchr (buffer
, '_');
6066 p
= p
? p
+ 1 : buffer
;
6067 if (strcmp (p
, "width") == 0)
6069 else if (strcmp (p
, "height") == 0)
6072 expect (XBM_TK_NUMBER
);
6075 if (*width
< 0 || *height
< 0)
6078 /* Parse bits. Must start with `static'. */
6079 expect_ident ("static");
6080 if (LA1
== XBM_TK_IDENT
)
6082 if (strcmp (buffer
, "unsigned") == 0)
6085 expect_ident ("char");
6087 else if (strcmp (buffer
, "short") == 0)
6091 if (*width
% 16 && *width
% 16 < 9)
6094 else if (strcmp (buffer
, "char") == 0)
6102 expect (XBM_TK_IDENT
);
6108 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6109 nbytes
= bytes_per_line
* *height
;
6110 p
= *data
= (char *) xmalloc (nbytes
);
6114 for (i
= 0; i
< nbytes
; i
+= 2)
6117 expect (XBM_TK_NUMBER
);
6120 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6123 if (LA1
== ',' || LA1
== '}')
6131 for (i
= 0; i
< nbytes
; ++i
)
6134 expect (XBM_TK_NUMBER
);
6138 if (LA1
== ',' || LA1
== '}')
6164 /* Load XBM image IMG which will be displayed on frame F from file
6165 SPECIFIED_FILE. Value is non-zero if successful. */
6168 xbm_load_image_from_file (f
, img
, specified_file
)
6171 Lisp_Object specified_file
;
6174 unsigned char *data
;
6177 struct gcpro gcpro1
;
6179 xassert (STRINGP (specified_file
));
6183 file
= x_find_image_file (specified_file
);
6184 if (!STRINGP (file
))
6186 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6191 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6192 &img
->height
, &data
);
6195 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6196 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6197 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6200 xassert (img
->width
> 0 && img
->height
> 0);
6202 /* Get foreground and background colors, maybe allocate colors. */
6203 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6205 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6207 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6209 background
= x_alloc_image_color (f
, img
, value
, background
);
6213 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6216 img
->width
, img
->height
,
6217 foreground
, background
,
6221 if (img
->pixmap
== 0)
6223 x_clear_image (f
, img
);
6224 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6232 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6239 /* Fill image IMG which is used on frame F with pixmap data. Value is
6240 non-zero if successful. */
6248 Lisp_Object file_name
;
6250 xassert (xbm_image_p (img
->spec
));
6252 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6253 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6254 if (STRINGP (file_name
))
6255 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6258 struct image_keyword fmt
[XBM_LAST
];
6261 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6262 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6266 /* Parse the list specification. */
6267 bcopy (xbm_format
, fmt
, sizeof fmt
);
6268 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6271 /* Get specified width, and height. */
6272 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6273 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6274 xassert (img
->width
> 0 && img
->height
> 0);
6278 if (fmt
[XBM_ASCENT
].count
)
6279 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6281 /* Get foreground and background colors, maybe allocate colors. */
6282 if (fmt
[XBM_FOREGROUND
].count
)
6283 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6285 if (fmt
[XBM_BACKGROUND
].count
)
6286 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6289 /* Set bits to the bitmap image data. */
6290 data
= fmt
[XBM_DATA
].value
;
6295 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6297 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6298 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6300 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6302 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6304 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6307 else if (STRINGP (data
))
6308 bits
= XSTRING (data
)->data
;
6310 bits
= XBOOL_VECTOR (data
)->data
;
6312 /* Create the pixmap. */
6313 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6315 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6318 img
->width
, img
->height
,
6319 foreground
, background
,
6325 image_error ("Unable to create pixmap for XBM image `%s'",
6327 x_clear_image (f
, img
);
6338 /***********************************************************************
6340 ***********************************************************************/
6344 static int xpm_image_p
P_ ((Lisp_Object object
));
6345 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6346 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6348 #include "X11/xpm.h"
6350 /* The symbol `xpm' identifying XPM-format images. */
6354 /* Indices of image specification fields in xpm_format, below. */
6356 enum xpm_keyword_index
6370 /* Vector of image_keyword structures describing the format
6371 of valid XPM image specifications. */
6373 static struct image_keyword xpm_format
[XPM_LAST
] =
6375 {":type", IMAGE_SYMBOL_VALUE
, 1},
6376 {":file", IMAGE_STRING_VALUE
, 0},
6377 {":data", IMAGE_STRING_VALUE
, 0},
6378 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6379 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6380 {":relief", IMAGE_INTEGER_VALUE
, 0},
6381 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6382 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6383 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6386 /* Structure describing the image type XBM. */
6388 static struct image_type xpm_type
=
6398 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6399 for XPM images. Such a list must consist of conses whose car and
6403 xpm_valid_color_symbols_p (color_symbols
)
6404 Lisp_Object color_symbols
;
6406 while (CONSP (color_symbols
))
6408 Lisp_Object sym
= XCAR (color_symbols
);
6410 || !STRINGP (XCAR (sym
))
6411 || !STRINGP (XCDR (sym
)))
6413 color_symbols
= XCDR (color_symbols
);
6416 return NILP (color_symbols
);
6420 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6423 xpm_image_p (object
)
6426 struct image_keyword fmt
[XPM_LAST
];
6427 bcopy (xpm_format
, fmt
, sizeof fmt
);
6428 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6429 /* Either `:file' or `:data' must be present. */
6430 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6431 /* Either no `:color-symbols' or it's a list of conses
6432 whose car and cdr are strings. */
6433 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6434 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6435 && (fmt
[XPM_ASCENT
].count
== 0
6436 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6440 /* Load image IMG which will be displayed on frame F. Value is
6441 non-zero if successful. */
6449 XpmAttributes attrs
;
6450 Lisp_Object specified_file
, color_symbols
;
6452 /* Configure the XPM lib. Use the visual of frame F. Allocate
6453 close colors. Return colors allocated. */
6454 bzero (&attrs
, sizeof attrs
);
6455 attrs
.visual
= FRAME_X_VISUAL (f
);
6456 attrs
.colormap
= FRAME_X_COLORMAP (f
);
6457 attrs
.valuemask
|= XpmVisual
;
6458 attrs
.valuemask
|= XpmColormap
;
6459 attrs
.valuemask
|= XpmReturnAllocPixels
;
6460 #ifdef XpmAllocCloseColors
6461 attrs
.alloc_close_colors
= 1;
6462 attrs
.valuemask
|= XpmAllocCloseColors
;
6464 attrs
.closeness
= 600;
6465 attrs
.valuemask
|= XpmCloseness
;
6468 /* If image specification contains symbolic color definitions, add
6469 these to `attrs'. */
6470 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
6471 if (CONSP (color_symbols
))
6474 XpmColorSymbol
*xpm_syms
;
6477 attrs
.valuemask
|= XpmColorSymbols
;
6479 /* Count number of symbols. */
6480 attrs
.numsymbols
= 0;
6481 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
6484 /* Allocate an XpmColorSymbol array. */
6485 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
6486 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
6487 bzero (xpm_syms
, size
);
6488 attrs
.colorsymbols
= xpm_syms
;
6490 /* Fill the color symbol array. */
6491 for (tail
= color_symbols
, i
= 0;
6493 ++i
, tail
= XCDR (tail
))
6495 Lisp_Object name
= XCAR (XCAR (tail
));
6496 Lisp_Object color
= XCDR (XCAR (tail
));
6497 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
6498 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
6499 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
6500 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
6504 /* Create a pixmap for the image, either from a file, or from a
6505 string buffer containing data in the same format as an XPM file. */
6507 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6508 if (STRINGP (specified_file
))
6510 Lisp_Object file
= x_find_image_file (specified_file
);
6511 if (!STRINGP (file
))
6513 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6518 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6519 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
6524 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
6525 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6526 XSTRING (buffer
)->data
,
6527 &img
->pixmap
, &img
->mask
,
6532 if (rc
== XpmSuccess
)
6534 /* Remember allocated colors. */
6535 img
->ncolors
= attrs
.nalloc_pixels
;
6536 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
6537 * sizeof *img
->colors
);
6538 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
6539 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
6541 img
->width
= attrs
.width
;
6542 img
->height
= attrs
.height
;
6543 xassert (img
->width
> 0 && img
->height
> 0);
6545 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6547 XpmFreeAttributes (&attrs
);
6555 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
6558 case XpmFileInvalid
:
6559 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
6563 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
6566 case XpmColorFailed
:
6567 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
6571 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
6576 return rc
== XpmSuccess
;
6579 #endif /* HAVE_XPM != 0 */
6582 /***********************************************************************
6584 ***********************************************************************/
6586 /* An entry in the color table mapping an RGB color to a pixel color. */
6591 unsigned long pixel
;
6593 /* Next in color table collision list. */
6594 struct ct_color
*next
;
6597 /* The bucket vector size to use. Must be prime. */
6601 /* Value is a hash of the RGB color given by R, G, and B. */
6603 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6605 /* The color hash table. */
6607 struct ct_color
**ct_table
;
6609 /* Number of entries in the color table. */
6611 int ct_colors_allocated
;
6613 /* Function prototypes. */
6615 static void init_color_table
P_ ((void));
6616 static void free_color_table
P_ ((void));
6617 static unsigned long *colors_in_color_table
P_ ((int *n
));
6618 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
6619 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
6622 /* Initialize the color table. */
6627 int size
= CT_SIZE
* sizeof (*ct_table
);
6628 ct_table
= (struct ct_color
**) xmalloc (size
);
6629 bzero (ct_table
, size
);
6630 ct_colors_allocated
= 0;
6634 /* Free memory associated with the color table. */
6640 struct ct_color
*p
, *next
;
6642 for (i
= 0; i
< CT_SIZE
; ++i
)
6643 for (p
= ct_table
[i
]; p
; p
= next
)
6654 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6655 entry for that color already is in the color table, return the
6656 pixel color of that entry. Otherwise, allocate a new color for R,
6657 G, B, and make an entry in the color table. */
6659 static unsigned long
6660 lookup_rgb_color (f
, r
, g
, b
)
6664 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
6665 int i
= hash
% CT_SIZE
;
6668 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6669 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
6683 cmap
= FRAME_X_COLORMAP (f
);
6684 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6689 ++ct_colors_allocated
;
6691 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6695 p
->pixel
= color
.pixel
;
6696 p
->next
= ct_table
[i
];
6700 return FRAME_FOREGROUND_PIXEL (f
);
6707 /* Look up pixel color PIXEL which is used on frame F in the color
6708 table. If not already present, allocate it. Value is PIXEL. */
6710 static unsigned long
6711 lookup_pixel_color (f
, pixel
)
6713 unsigned long pixel
;
6715 int i
= pixel
% CT_SIZE
;
6718 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6719 if (p
->pixel
== pixel
)
6730 cmap
= FRAME_X_COLORMAP (f
);
6731 color
.pixel
= pixel
;
6732 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
6733 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6738 ++ct_colors_allocated
;
6740 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6745 p
->next
= ct_table
[i
];
6749 return FRAME_FOREGROUND_PIXEL (f
);
6756 /* Value is a vector of all pixel colors contained in the color table,
6757 allocated via xmalloc. Set *N to the number of colors. */
6759 static unsigned long *
6760 colors_in_color_table (n
)
6765 unsigned long *colors
;
6767 if (ct_colors_allocated
== 0)
6774 colors
= (unsigned long *) xmalloc (ct_colors_allocated
6776 *n
= ct_colors_allocated
;
6778 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
6779 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6780 colors
[j
++] = p
->pixel
;
6788 /***********************************************************************
6790 ***********************************************************************/
6792 static void x_laplace_write_row
P_ ((struct frame
*, long *,
6793 int, XImage
*, int));
6794 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
6795 XColor
*, int, XImage
*, int));
6798 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6799 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6800 the width of one row in the image. */
6803 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
6813 for (x
= 0; x
< width
; ++x
)
6814 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
6816 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
6820 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
6821 containing the pixel colors to write. F is the frame we are
6825 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
6834 for (x
= 0; x
< width
; ++x
)
6835 XPutPixel (ximg
, x
, y
, pixels
[x
]);
6839 /* Transform image IMG which is used on frame F with a Laplace
6840 edge-detection algorithm. The result is an image that can be used
6841 to draw disabled buttons, for example. */
6848 Colormap cmap
= FRAME_X_COLORMAP (f
);
6849 XImage
*ximg
, *oimg
;
6855 int in_y
, out_y
, rc
;
6860 /* Get the X image IMG->pixmap. */
6861 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6862 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6864 /* Allocate 3 input rows, and one output row of colors. */
6865 for (i
= 0; i
< 3; ++i
)
6866 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
6867 out
= (long *) alloca (img
->width
* sizeof (long));
6869 /* Create an X image for output. */
6870 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
6873 /* Fill first two rows. */
6874 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
6875 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
6878 /* Write first row, all zeros. */
6879 init_color_table ();
6880 pixel
= lookup_rgb_color (f
, 0, 0, 0);
6881 for (x
= 0; x
< img
->width
; ++x
)
6883 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
6886 for (y
= 2; y
< img
->height
; ++y
)
6889 int rowb
= (y
+ 2) % 3;
6891 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
6893 for (x
= 0; x
< img
->width
- 2; ++x
)
6895 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
6896 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
6897 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
6899 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
6903 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
6906 /* Write last line, all zeros. */
6907 for (x
= 0; x
< img
->width
; ++x
)
6909 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
6911 /* Free the input image, and free resources of IMG. */
6912 XDestroyImage (ximg
);
6913 x_clear_image (f
, img
);
6915 /* Put the output image into pixmap, and destroy it. */
6916 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
6917 x_destroy_x_image (oimg
);
6919 /* Remember new pixmap and colors in IMG. */
6920 img
->pixmap
= pixmap
;
6921 img
->colors
= colors_in_color_table (&img
->ncolors
);
6922 free_color_table ();
6928 /* Build a mask for image IMG which is used on frame F. FILE is the
6929 name of an image file, for error messages. HOW determines how to
6930 determine the background color of IMG. If it is a list '(R G B)',
6931 with R, G, and B being integers >= 0, take that as the color of the
6932 background. Otherwise, determine the background color of IMG
6933 heuristically. Value is non-zero if successful. */
6936 x_build_heuristic_mask (f
, img
, how
)
6941 Display
*dpy
= FRAME_X_DISPLAY (f
);
6942 XImage
*ximg
, *mask_img
;
6943 int x
, y
, rc
, look_at_corners_p
;
6948 /* Create an image and pixmap serving as mask. */
6949 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
6950 &mask_img
, &img
->mask
);
6957 /* Get the X image of IMG->pixmap. */
6958 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
6961 /* Determine the background color of ximg. If HOW is `(R G B)'
6962 take that as color. Otherwise, try to determine the color
6964 look_at_corners_p
= 1;
6972 && NATNUMP (XCAR (how
)))
6974 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
6978 if (i
== 3 && NILP (how
))
6980 char color_name
[30];
6981 XColor exact
, color
;
6984 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
6986 cmap
= FRAME_X_COLORMAP (f
);
6987 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
6990 look_at_corners_p
= 0;
6995 if (look_at_corners_p
)
6997 unsigned long corners
[4];
7000 /* Get the colors at the corners of ximg. */
7001 corners
[0] = XGetPixel (ximg
, 0, 0);
7002 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7003 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7004 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7006 /* Choose the most frequently found color as background. */
7007 for (i
= best_count
= 0; i
< 4; ++i
)
7011 for (j
= n
= 0; j
< 4; ++j
)
7012 if (corners
[i
] == corners
[j
])
7016 bg
= corners
[i
], best_count
= n
;
7020 /* Set all bits in mask_img to 1 whose color in ximg is different
7021 from the background color bg. */
7022 for (y
= 0; y
< img
->height
; ++y
)
7023 for (x
= 0; x
< img
->width
; ++x
)
7024 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7026 /* Put mask_img into img->mask. */
7027 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7028 x_destroy_x_image (mask_img
);
7029 XDestroyImage (ximg
);
7037 /***********************************************************************
7038 PBM (mono, gray, color)
7039 ***********************************************************************/
7041 static int pbm_image_p
P_ ((Lisp_Object object
));
7042 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7043 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7045 /* The symbol `pbm' identifying images of this type. */
7049 /* Indices of image specification fields in gs_format, below. */
7051 enum pbm_keyword_index
7064 /* Vector of image_keyword structures describing the format
7065 of valid user-defined image specifications. */
7067 static struct image_keyword pbm_format
[PBM_LAST
] =
7069 {":type", IMAGE_SYMBOL_VALUE
, 1},
7070 {":file", IMAGE_STRING_VALUE
, 0},
7071 {":data", IMAGE_STRING_VALUE
, 0},
7072 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7073 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7074 {":relief", IMAGE_INTEGER_VALUE
, 0},
7075 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7076 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7079 /* Structure describing the image type `pbm'. */
7081 static struct image_type pbm_type
=
7091 /* Return non-zero if OBJECT is a valid PBM image specification. */
7094 pbm_image_p (object
)
7097 struct image_keyword fmt
[PBM_LAST
];
7099 bcopy (pbm_format
, fmt
, sizeof fmt
);
7101 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7102 || (fmt
[PBM_ASCENT
].count
7103 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7106 /* Must specify either :data or :file. */
7107 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7111 /* Scan a decimal number from *S and return it. Advance *S while
7112 reading the number. END is the end of the string. Value is -1 at
7116 pbm_scan_number (s
, end
)
7117 unsigned char **s
, *end
;
7123 /* Skip white-space. */
7124 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7129 /* Skip comment to end of line. */
7130 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7133 else if (isdigit (c
))
7135 /* Read decimal number. */
7137 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7138 val
= 10 * val
+ c
- '0';
7149 /* Read FILE into memory. Value is a pointer to a buffer allocated
7150 with xmalloc holding FILE's contents. Value is null if an error
7151 occured. *SIZE is set to the size of the file. */
7154 pbm_read_file (file
, size
)
7162 if (stat (XSTRING (file
)->data
, &st
) == 0
7163 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
7164 && (buf
= (char *) xmalloc (st
.st_size
),
7165 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
7185 /* Load PBM image IMG for use on frame F. */
7193 int width
, height
, max_color_idx
= 0;
7195 Lisp_Object file
, specified_file
;
7196 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7197 struct gcpro gcpro1
;
7198 unsigned char *contents
= NULL
;
7199 unsigned char *end
, *p
;
7202 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7206 if (STRINGP (specified_file
))
7208 file
= x_find_image_file (specified_file
);
7209 if (!STRINGP (file
))
7211 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7216 contents
= pbm_read_file (file
, &size
);
7217 if (contents
== NULL
)
7219 image_error ("Error reading `%s'", file
, Qnil
);
7225 end
= contents
+ size
;
7230 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7231 p
= XSTRING (data
)->data
;
7232 end
= p
+ STRING_BYTES (XSTRING (data
));
7235 /* Check magic number. */
7236 if (end
- p
< 2 || *p
++ != 'P')
7238 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7248 raw_p
= 0, type
= PBM_MONO
;
7252 raw_p
= 0, type
= PBM_GRAY
;
7256 raw_p
= 0, type
= PBM_COLOR
;
7260 raw_p
= 1, type
= PBM_MONO
;
7264 raw_p
= 1, type
= PBM_GRAY
;
7268 raw_p
= 1, type
= PBM_COLOR
;
7272 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7276 /* Read width, height, maximum color-component. Characters
7277 starting with `#' up to the end of a line are ignored. */
7278 width
= pbm_scan_number (&p
, end
);
7279 height
= pbm_scan_number (&p
, end
);
7281 if (type
!= PBM_MONO
)
7283 max_color_idx
= pbm_scan_number (&p
, end
);
7284 if (raw_p
&& max_color_idx
> 255)
7285 max_color_idx
= 255;
7290 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7294 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7295 &ximg
, &img
->pixmap
))
7301 /* Initialize the color hash table. */
7302 init_color_table ();
7304 if (type
== PBM_MONO
)
7308 for (y
= 0; y
< height
; ++y
)
7309 for (x
= 0; x
< width
; ++x
)
7319 g
= pbm_scan_number (&p
, end
);
7321 XPutPixel (ximg
, x
, y
, (g
7322 ? FRAME_FOREGROUND_PIXEL (f
)
7323 : FRAME_BACKGROUND_PIXEL (f
)));
7328 for (y
= 0; y
< height
; ++y
)
7329 for (x
= 0; x
< width
; ++x
)
7333 if (type
== PBM_GRAY
)
7334 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7343 r
= pbm_scan_number (&p
, end
);
7344 g
= pbm_scan_number (&p
, end
);
7345 b
= pbm_scan_number (&p
, end
);
7348 if (r
< 0 || g
< 0 || b
< 0)
7352 XDestroyImage (ximg
);
7354 image_error ("Invalid pixel value in image `%s'",
7359 /* RGB values are now in the range 0..max_color_idx.
7360 Scale this to the range 0..0xffff supported by X. */
7361 r
= (double) r
* 65535 / max_color_idx
;
7362 g
= (double) g
* 65535 / max_color_idx
;
7363 b
= (double) b
* 65535 / max_color_idx
;
7364 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7368 /* Store in IMG->colors the colors allocated for the image, and
7369 free the color table. */
7370 img
->colors
= colors_in_color_table (&img
->ncolors
);
7371 free_color_table ();
7373 /* Put the image into a pixmap. */
7374 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7375 x_destroy_x_image (ximg
);
7379 img
->height
= height
;
7388 /***********************************************************************
7390 ***********************************************************************/
7396 /* Function prototypes. */
7398 static int png_image_p
P_ ((Lisp_Object object
));
7399 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7401 /* The symbol `png' identifying images of this type. */
7405 /* Indices of image specification fields in png_format, below. */
7407 enum png_keyword_index
7420 /* Vector of image_keyword structures describing the format
7421 of valid user-defined image specifications. */
7423 static struct image_keyword png_format
[PNG_LAST
] =
7425 {":type", IMAGE_SYMBOL_VALUE
, 1},
7426 {":data", IMAGE_STRING_VALUE
, 0},
7427 {":file", IMAGE_STRING_VALUE
, 0},
7428 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7429 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7430 {":relief", IMAGE_INTEGER_VALUE
, 0},
7431 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7432 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7435 /* Structure describing the image type `png'. */
7437 static struct image_type png_type
=
7447 /* Return non-zero if OBJECT is a valid PNG image specification. */
7450 png_image_p (object
)
7453 struct image_keyword fmt
[PNG_LAST
];
7454 bcopy (png_format
, fmt
, sizeof fmt
);
7456 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
7457 || (fmt
[PNG_ASCENT
].count
7458 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7461 /* Must specify either the :data or :file keyword. */
7462 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
7466 /* Error and warning handlers installed when the PNG library
7470 my_png_error (png_ptr
, msg
)
7471 png_struct
*png_ptr
;
7474 xassert (png_ptr
!= NULL
);
7475 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7476 longjmp (png_ptr
->jmpbuf
, 1);
7481 my_png_warning (png_ptr
, msg
)
7482 png_struct
*png_ptr
;
7485 xassert (png_ptr
!= NULL
);
7486 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
7489 /* Memory source for PNG decoding. */
7491 struct png_memory_storage
7493 unsigned char *bytes
; /* The data */
7494 size_t len
; /* How big is it? */
7495 int index
; /* Where are we? */
7499 /* Function set as reader function when reading PNG image from memory.
7500 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7501 bytes from the input to DATA. */
7504 png_read_from_memory (png_ptr
, data
, length
)
7505 png_structp png_ptr
;
7509 struct png_memory_storage
*tbr
7510 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
7512 if (length
> tbr
->len
- tbr
->index
)
7513 png_error (png_ptr
, "Read error");
7515 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
7516 tbr
->index
= tbr
->index
+ length
;
7519 /* Load PNG image IMG for use on frame F. Value is non-zero if
7527 Lisp_Object file
, specified_file
;
7528 Lisp_Object specified_data
;
7530 XImage
*ximg
, *mask_img
= NULL
;
7531 struct gcpro gcpro1
;
7532 png_struct
*png_ptr
= NULL
;
7533 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
7536 png_byte
*pixels
= NULL
;
7537 png_byte
**rows
= NULL
;
7538 png_uint_32 width
, height
;
7539 int bit_depth
, color_type
, interlace_type
;
7541 png_uint_32 row_bytes
;
7544 double screen_gamma
, image_gamma
;
7546 struct png_memory_storage tbr
; /* Data to be read */
7548 /* Find out what file to load. */
7549 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7550 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7554 if (NILP (specified_data
))
7556 file
= x_find_image_file (specified_file
);
7557 if (!STRINGP (file
))
7559 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7564 /* Open the image file. */
7565 fp
= fopen (XSTRING (file
)->data
, "rb");
7568 image_error ("Cannot open image file `%s'", file
, Qnil
);
7574 /* Check PNG signature. */
7575 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
7576 || !png_check_sig (sig
, sizeof sig
))
7578 image_error ("Not a PNG file: `%s'", file
, Qnil
);
7586 /* Read from memory. */
7587 tbr
.bytes
= XSTRING (specified_data
)->data
;
7588 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
7591 /* Check PNG signature. */
7592 if (tbr
.len
< sizeof sig
7593 || !png_check_sig (tbr
.bytes
, sizeof sig
))
7595 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
7600 /* Need to skip past the signature. */
7601 tbr
.bytes
+= sizeof (sig
);
7604 /* Initialize read and info structs for PNG lib. */
7605 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
7606 my_png_error
, my_png_warning
);
7609 if (fp
) fclose (fp
);
7614 info_ptr
= png_create_info_struct (png_ptr
);
7617 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
7618 if (fp
) fclose (fp
);
7623 end_info
= png_create_info_struct (png_ptr
);
7626 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
7627 if (fp
) fclose (fp
);
7632 /* Set error jump-back. We come back here when the PNG library
7633 detects an error. */
7634 if (setjmp (png_ptr
->jmpbuf
))
7638 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7641 if (fp
) fclose (fp
);
7646 /* Read image info. */
7647 if (!NILP (specified_data
))
7648 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
7650 png_init_io (png_ptr
, fp
);
7652 png_set_sig_bytes (png_ptr
, sizeof sig
);
7653 png_read_info (png_ptr
, info_ptr
);
7654 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
7655 &interlace_type
, NULL
, NULL
);
7657 /* If image contains simply transparency data, we prefer to
7658 construct a clipping mask. */
7659 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
7664 /* This function is easier to write if we only have to handle
7665 one data format: RGB or RGBA with 8 bits per channel. Let's
7666 transform other formats into that format. */
7668 /* Strip more than 8 bits per channel. */
7669 if (bit_depth
== 16)
7670 png_set_strip_16 (png_ptr
);
7672 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7674 png_set_expand (png_ptr
);
7676 /* Convert grayscale images to RGB. */
7677 if (color_type
== PNG_COLOR_TYPE_GRAY
7678 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
7679 png_set_gray_to_rgb (png_ptr
);
7681 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7682 gamma_str
= getenv ("SCREEN_GAMMA");
7683 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
7685 /* Tell the PNG lib to handle gamma correction for us. */
7687 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7688 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
7689 /* There is a special chunk in the image specifying the gamma. */
7690 png_set_sRGB (png_ptr
, info_ptr
, intent
);
7693 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
7694 /* Image contains gamma information. */
7695 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
7697 /* Use a default of 0.5 for the image gamma. */
7698 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
7700 /* Handle alpha channel by combining the image with a background
7701 color. Do this only if a real alpha channel is supplied. For
7702 simple transparency, we prefer a clipping mask. */
7705 png_color_16
*image_background
;
7707 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
7708 /* Image contains a background color with which to
7709 combine the image. */
7710 png_set_background (png_ptr
, image_background
,
7711 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
7714 /* Image does not contain a background color with which
7715 to combine the image data via an alpha channel. Use
7716 the frame's background instead. */
7719 png_color_16 frame_background
;
7722 cmap
= FRAME_X_COLORMAP (f
);
7723 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
7724 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7727 bzero (&frame_background
, sizeof frame_background
);
7728 frame_background
.red
= color
.red
;
7729 frame_background
.green
= color
.green
;
7730 frame_background
.blue
= color
.blue
;
7732 png_set_background (png_ptr
, &frame_background
,
7733 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
7737 /* Update info structure. */
7738 png_read_update_info (png_ptr
, info_ptr
);
7740 /* Get number of channels. Valid values are 1 for grayscale images
7741 and images with a palette, 2 for grayscale images with transparency
7742 information (alpha channel), 3 for RGB images, and 4 for RGB
7743 images with alpha channel, i.e. RGBA. If conversions above were
7744 sufficient we should only have 3 or 4 channels here. */
7745 channels
= png_get_channels (png_ptr
, info_ptr
);
7746 xassert (channels
== 3 || channels
== 4);
7748 /* Number of bytes needed for one row of the image. */
7749 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
7751 /* Allocate memory for the image. */
7752 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
7753 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
7754 for (i
= 0; i
< height
; ++i
)
7755 rows
[i
] = pixels
+ i
* row_bytes
;
7757 /* Read the entire image. */
7758 png_read_image (png_ptr
, rows
);
7759 png_read_end (png_ptr
, info_ptr
);
7768 /* Create the X image and pixmap. */
7769 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
7776 /* Create an image and pixmap serving as mask if the PNG image
7777 contains an alpha channel. */
7780 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
7781 &mask_img
, &img
->mask
))
7783 x_destroy_x_image (ximg
);
7784 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
7790 /* Fill the X image and mask from PNG data. */
7791 init_color_table ();
7793 for (y
= 0; y
< height
; ++y
)
7795 png_byte
*p
= rows
[y
];
7797 for (x
= 0; x
< width
; ++x
)
7804 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7806 /* An alpha channel, aka mask channel, associates variable
7807 transparency with an image. Where other image formats
7808 support binary transparency---fully transparent or fully
7809 opaque---PNG allows up to 254 levels of partial transparency.
7810 The PNG library implements partial transparency by combining
7811 the image with a specified background color.
7813 I'm not sure how to handle this here nicely: because the
7814 background on which the image is displayed may change, for
7815 real alpha channel support, it would be necessary to create
7816 a new image for each possible background.
7818 What I'm doing now is that a mask is created if we have
7819 boolean transparency information. Otherwise I'm using
7820 the frame's background color to combine the image with. */
7825 XPutPixel (mask_img
, x
, y
, *p
> 0);
7831 /* Remember colors allocated for this image. */
7832 img
->colors
= colors_in_color_table (&img
->ncolors
);
7833 free_color_table ();
7836 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7841 img
->height
= height
;
7843 /* Put the image into the pixmap, then free the X image and its buffer. */
7844 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7845 x_destroy_x_image (ximg
);
7847 /* Same for the mask. */
7850 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7851 x_destroy_x_image (mask_img
);
7859 #endif /* HAVE_PNG != 0 */
7863 /***********************************************************************
7865 ***********************************************************************/
7869 /* Work around a warning about HAVE_STDLIB_H being redefined in
7871 #ifdef HAVE_STDLIB_H
7872 #define HAVE_STDLIB_H_1
7873 #undef HAVE_STDLIB_H
7874 #endif /* HAVE_STLIB_H */
7876 #include <jpeglib.h>
7880 #ifdef HAVE_STLIB_H_1
7881 #define HAVE_STDLIB_H 1
7884 static int jpeg_image_p
P_ ((Lisp_Object object
));
7885 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
7887 /* The symbol `jpeg' identifying images of this type. */
7891 /* Indices of image specification fields in gs_format, below. */
7893 enum jpeg_keyword_index
7902 JPEG_HEURISTIC_MASK
,
7906 /* Vector of image_keyword structures describing the format
7907 of valid user-defined image specifications. */
7909 static struct image_keyword jpeg_format
[JPEG_LAST
] =
7911 {":type", IMAGE_SYMBOL_VALUE
, 1},
7912 {":data", IMAGE_STRING_VALUE
, 0},
7913 {":file", IMAGE_STRING_VALUE
, 0},
7914 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7915 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7916 {":relief", IMAGE_INTEGER_VALUE
, 0},
7917 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7918 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7921 /* Structure describing the image type `jpeg'. */
7923 static struct image_type jpeg_type
=
7933 /* Return non-zero if OBJECT is a valid JPEG image specification. */
7936 jpeg_image_p (object
)
7939 struct image_keyword fmt
[JPEG_LAST
];
7941 bcopy (jpeg_format
, fmt
, sizeof fmt
);
7943 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
7944 || (fmt
[JPEG_ASCENT
].count
7945 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
7948 /* Must specify either the :data or :file keyword. */
7949 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
7953 struct my_jpeg_error_mgr
7955 struct jpeg_error_mgr pub
;
7956 jmp_buf setjmp_buffer
;
7961 my_error_exit (cinfo
)
7964 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
7965 longjmp (mgr
->setjmp_buffer
, 1);
7969 /* Init source method for JPEG data source manager. Called by
7970 jpeg_read_header() before any data is actually read. See
7971 libjpeg.doc from the JPEG lib distribution. */
7974 our_init_source (cinfo
)
7975 j_decompress_ptr cinfo
;
7980 /* Fill input buffer method for JPEG data source manager. Called
7981 whenever more data is needed. We read the whole image in one step,
7982 so this only adds a fake end of input marker at the end. */
7985 our_fill_input_buffer (cinfo
)
7986 j_decompress_ptr cinfo
;
7988 /* Insert a fake EOI marker. */
7989 struct jpeg_source_mgr
*src
= cinfo
->src
;
7990 static JOCTET buffer
[2];
7992 buffer
[0] = (JOCTET
) 0xFF;
7993 buffer
[1] = (JOCTET
) JPEG_EOI
;
7995 src
->next_input_byte
= buffer
;
7996 src
->bytes_in_buffer
= 2;
8001 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8002 is the JPEG data source manager. */
8005 our_skip_input_data (cinfo
, num_bytes
)
8006 j_decompress_ptr cinfo
;
8009 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8013 if (num_bytes
> src
->bytes_in_buffer
)
8014 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8016 src
->bytes_in_buffer
-= num_bytes
;
8017 src
->next_input_byte
+= num_bytes
;
8022 /* Method to terminate data source. Called by
8023 jpeg_finish_decompress() after all data has been processed. */
8026 our_term_source (cinfo
)
8027 j_decompress_ptr cinfo
;
8032 /* Set up the JPEG lib for reading an image from DATA which contains
8033 LEN bytes. CINFO is the decompression info structure created for
8034 reading the image. */
8037 jpeg_memory_src (cinfo
, data
, len
)
8038 j_decompress_ptr cinfo
;
8042 struct jpeg_source_mgr
*src
;
8044 if (cinfo
->src
== NULL
)
8046 /* First time for this JPEG object? */
8047 cinfo
->src
= (struct jpeg_source_mgr
*)
8048 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8049 sizeof (struct jpeg_source_mgr
));
8050 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8051 src
->next_input_byte
= data
;
8054 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8055 src
->init_source
= our_init_source
;
8056 src
->fill_input_buffer
= our_fill_input_buffer
;
8057 src
->skip_input_data
= our_skip_input_data
;
8058 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8059 src
->term_source
= our_term_source
;
8060 src
->bytes_in_buffer
= len
;
8061 src
->next_input_byte
= data
;
8065 /* Load image IMG for use on frame F. Patterned after example.c
8066 from the JPEG lib. */
8073 struct jpeg_decompress_struct cinfo
;
8074 struct my_jpeg_error_mgr mgr
;
8075 Lisp_Object file
, specified_file
;
8076 Lisp_Object specified_data
;
8079 int row_stride
, x
, y
;
8080 XImage
*ximg
= NULL
;
8082 unsigned long *colors
;
8084 struct gcpro gcpro1
;
8086 /* Open the JPEG file. */
8087 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8088 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8092 if (NILP (specified_data
))
8094 file
= x_find_image_file (specified_file
);
8095 if (!STRINGP (file
))
8097 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8102 fp
= fopen (XSTRING (file
)->data
, "r");
8105 image_error ("Cannot open `%s'", file
, Qnil
);
8111 /* Customize libjpeg's error handling to call my_error_exit when an
8112 error is detected. This function will perform a longjmp. */
8113 mgr
.pub
.error_exit
= my_error_exit
;
8114 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8116 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8120 /* Called from my_error_exit. Display a JPEG error. */
8121 char buffer
[JMSG_LENGTH_MAX
];
8122 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8123 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8124 build_string (buffer
));
8127 /* Close the input file and destroy the JPEG object. */
8130 jpeg_destroy_decompress (&cinfo
);
8134 /* If we already have an XImage, free that. */
8135 x_destroy_x_image (ximg
);
8137 /* Free pixmap and colors. */
8138 x_clear_image (f
, img
);
8145 /* Create the JPEG decompression object. Let it read from fp.
8146 Read the JPEG image header. */
8147 jpeg_create_decompress (&cinfo
);
8149 if (NILP (specified_data
))
8150 jpeg_stdio_src (&cinfo
, fp
);
8152 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8153 STRING_BYTES (XSTRING (specified_data
)));
8155 jpeg_read_header (&cinfo
, TRUE
);
8157 /* Customize decompression so that color quantization will be used.
8158 Start decompression. */
8159 cinfo
.quantize_colors
= TRUE
;
8160 jpeg_start_decompress (&cinfo
);
8161 width
= img
->width
= cinfo
.output_width
;
8162 height
= img
->height
= cinfo
.output_height
;
8166 /* Create X image and pixmap. */
8167 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8170 longjmp (mgr
.setjmp_buffer
, 2);
8173 /* Allocate colors. When color quantization is used,
8174 cinfo.actual_number_of_colors has been set with the number of
8175 colors generated, and cinfo.colormap is a two-dimensional array
8176 of color indices in the range 0..cinfo.actual_number_of_colors.
8177 No more than 255 colors will be generated. */
8181 if (cinfo
.out_color_components
> 2)
8182 ir
= 0, ig
= 1, ib
= 2;
8183 else if (cinfo
.out_color_components
> 1)
8184 ir
= 0, ig
= 1, ib
= 0;
8186 ir
= 0, ig
= 0, ib
= 0;
8188 /* Use the color table mechanism because it handles colors that
8189 cannot be allocated nicely. Such colors will be replaced with
8190 a default color, and we don't have to care about which colors
8191 can be freed safely, and which can't. */
8192 init_color_table ();
8193 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8196 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8198 /* Multiply RGB values with 255 because X expects RGB values
8199 in the range 0..0xffff. */
8200 int r
= cinfo
.colormap
[ir
][i
] << 8;
8201 int g
= cinfo
.colormap
[ig
][i
] << 8;
8202 int b
= cinfo
.colormap
[ib
][i
] << 8;
8203 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8206 /* Remember those colors actually allocated. */
8207 img
->colors
= colors_in_color_table (&img
->ncolors
);
8208 free_color_table ();
8212 row_stride
= width
* cinfo
.output_components
;
8213 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8215 for (y
= 0; y
< height
; ++y
)
8217 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8218 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8219 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8223 jpeg_finish_decompress (&cinfo
);
8224 jpeg_destroy_decompress (&cinfo
);
8228 /* Put the image into the pixmap. */
8229 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8230 x_destroy_x_image (ximg
);
8236 #endif /* HAVE_JPEG */
8240 /***********************************************************************
8242 ***********************************************************************/
8248 static int tiff_image_p
P_ ((Lisp_Object object
));
8249 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8251 /* The symbol `tiff' identifying images of this type. */
8255 /* Indices of image specification fields in tiff_format, below. */
8257 enum tiff_keyword_index
8266 TIFF_HEURISTIC_MASK
,
8270 /* Vector of image_keyword structures describing the format
8271 of valid user-defined image specifications. */
8273 static struct image_keyword tiff_format
[TIFF_LAST
] =
8275 {":type", IMAGE_SYMBOL_VALUE
, 1},
8276 {":data", IMAGE_STRING_VALUE
, 0},
8277 {":file", IMAGE_STRING_VALUE
, 0},
8278 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8279 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8280 {":relief", IMAGE_INTEGER_VALUE
, 0},
8281 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8282 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8285 /* Structure describing the image type `tiff'. */
8287 static struct image_type tiff_type
=
8297 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8300 tiff_image_p (object
)
8303 struct image_keyword fmt
[TIFF_LAST
];
8304 bcopy (tiff_format
, fmt
, sizeof fmt
);
8306 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
8307 || (fmt
[TIFF_ASCENT
].count
8308 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8311 /* Must specify either the :data or :file keyword. */
8312 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8316 /* Reading from a memory buffer for TIFF images Based on the PNG
8317 memory source, but we have to provide a lot of extra functions.
8320 We really only need to implement read and seek, but I am not
8321 convinced that the TIFF library is smart enough not to destroy
8322 itself if we only hand it the function pointers we need to
8327 unsigned char *bytes
;
8335 tiff_read_from_memory (data
, buf
, size
)
8340 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8342 if (size
> src
->len
- src
->index
)
8344 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8351 tiff_write_from_memory (data
, buf
, size
)
8361 tiff_seek_in_memory (data
, off
, whence
)
8366 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8371 case SEEK_SET
: /* Go from beginning of source. */
8375 case SEEK_END
: /* Go from end of source. */
8376 idx
= src
->len
+ off
;
8379 case SEEK_CUR
: /* Go from current position. */
8380 idx
= src
->index
+ off
;
8383 default: /* Invalid `whence'. */
8387 if (idx
> src
->len
|| idx
< 0)
8396 tiff_close_memory (data
)
8405 tiff_mmap_memory (data
, pbase
, psize
)
8410 /* It is already _IN_ memory. */
8416 tiff_unmap_memory (data
, base
, size
)
8421 /* We don't need to do this. */
8426 tiff_size_of_memory (data
)
8429 return ((tiff_memory_source
*) data
)->len
;
8433 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8441 Lisp_Object file
, specified_file
;
8442 Lisp_Object specified_data
;
8444 int width
, height
, x
, y
;
8448 struct gcpro gcpro1
;
8449 tiff_memory_source memsrc
;
8451 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8452 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8456 if (NILP (specified_data
))
8458 /* Read from a file */
8459 file
= x_find_image_file (specified_file
);
8460 if (!STRINGP (file
))
8462 image_error ("Cannot find image file `%s'", file
, Qnil
);
8467 /* Try to open the image file. */
8468 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8471 image_error ("Cannot open `%s'", file
, Qnil
);
8478 /* Memory source! */
8479 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8480 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8483 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
8484 (TIFFReadWriteProc
) tiff_read_from_memory
,
8485 (TIFFReadWriteProc
) tiff_write_from_memory
,
8486 tiff_seek_in_memory
,
8488 tiff_size_of_memory
,
8494 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
8500 /* Get width and height of the image, and allocate a raster buffer
8501 of width x height 32-bit values. */
8502 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8503 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8504 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8506 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8510 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
8518 /* Create the X image and pixmap. */
8519 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8527 /* Initialize the color table. */
8528 init_color_table ();
8530 /* Process the pixel raster. Origin is in the lower-left corner. */
8531 for (y
= 0; y
< height
; ++y
)
8533 uint32
*row
= buf
+ y
* width
;
8535 for (x
= 0; x
< width
; ++x
)
8537 uint32 abgr
= row
[x
];
8538 int r
= TIFFGetR (abgr
) << 8;
8539 int g
= TIFFGetG (abgr
) << 8;
8540 int b
= TIFFGetB (abgr
) << 8;
8541 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8545 /* Remember the colors allocated for the image. Free the color table. */
8546 img
->colors
= colors_in_color_table (&img
->ncolors
);
8547 free_color_table ();
8549 /* Put the image into the pixmap, then free the X image and its buffer. */
8550 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8551 x_destroy_x_image (ximg
);
8556 img
->height
= height
;
8562 #endif /* HAVE_TIFF != 0 */
8566 /***********************************************************************
8568 ***********************************************************************/
8572 #include <gif_lib.h>
8574 static int gif_image_p
P_ ((Lisp_Object object
));
8575 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8577 /* The symbol `gif' identifying images of this type. */
8581 /* Indices of image specification fields in gif_format, below. */
8583 enum gif_keyword_index
8597 /* Vector of image_keyword structures describing the format
8598 of valid user-defined image specifications. */
8600 static struct image_keyword gif_format
[GIF_LAST
] =
8602 {":type", IMAGE_SYMBOL_VALUE
, 1},
8603 {":data", IMAGE_STRING_VALUE
, 0},
8604 {":file", IMAGE_STRING_VALUE
, 0},
8605 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8606 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8607 {":relief", IMAGE_INTEGER_VALUE
, 0},
8608 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8609 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8610 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8613 /* Structure describing the image type `gif'. */
8615 static struct image_type gif_type
=
8625 /* Return non-zero if OBJECT is a valid GIF image specification. */
8628 gif_image_p (object
)
8631 struct image_keyword fmt
[GIF_LAST
];
8632 bcopy (gif_format
, fmt
, sizeof fmt
);
8634 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
8635 || (fmt
[GIF_ASCENT
].count
8636 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8639 /* Must specify either the :data or :file keyword. */
8640 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
8644 /* Reading a GIF image from memory
8645 Based on the PNG memory stuff to a certain extent. */
8649 unsigned char *bytes
;
8656 /* Make the current memory source available to gif_read_from_memory.
8657 It's done this way because not all versions of libungif support
8658 a UserData field in the GifFileType structure. */
8659 static gif_memory_source
*current_gif_memory_src
;
8662 gif_read_from_memory (file
, buf
, len
)
8667 gif_memory_source
*src
= current_gif_memory_src
;
8669 if (len
> src
->len
- src
->index
)
8672 bcopy (src
->bytes
+ src
->index
, buf
, len
);
8678 /* Load GIF image IMG for use on frame F. Value is non-zero if
8686 Lisp_Object file
, specified_file
;
8687 Lisp_Object specified_data
;
8688 int rc
, width
, height
, x
, y
, i
;
8690 ColorMapObject
*gif_color_map
;
8691 unsigned long pixel_colors
[256];
8693 struct gcpro gcpro1
;
8695 int ino
, image_left
, image_top
, image_width
, image_height
;
8696 gif_memory_source memsrc
;
8697 unsigned char *raster
;
8699 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8700 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8704 if (NILP (specified_data
))
8706 file
= x_find_image_file (specified_file
);
8707 if (!STRINGP (file
))
8709 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8714 /* Open the GIF file. */
8715 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8718 image_error ("Cannot open `%s'", file
, Qnil
);
8725 /* Read from memory! */
8726 current_gif_memory_src
= &memsrc
;
8727 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8728 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8731 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
8734 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
8740 /* Read entire contents. */
8741 rc
= DGifSlurp (gif
);
8742 if (rc
== GIF_ERROR
)
8744 image_error ("Error reading `%s'", img
->spec
, Qnil
);
8745 DGifCloseFile (gif
);
8750 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8751 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8752 if (ino
>= gif
->ImageCount
)
8754 image_error ("Invalid image number `%s' in image `%s'",
8756 DGifCloseFile (gif
);
8761 width
= img
->width
= gif
->SWidth
;
8762 height
= img
->height
= gif
->SHeight
;
8766 /* Create the X image and pixmap. */
8767 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8770 DGifCloseFile (gif
);
8775 /* Allocate colors. */
8776 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8778 gif_color_map
= gif
->SColorMap
;
8779 init_color_table ();
8780 bzero (pixel_colors
, sizeof pixel_colors
);
8782 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8784 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8785 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8786 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8787 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8790 img
->colors
= colors_in_color_table (&img
->ncolors
);
8791 free_color_table ();
8793 /* Clear the part of the screen image that are not covered by
8794 the image from the GIF file. Full animated GIF support
8795 requires more than can be done here (see the gif89 spec,
8796 disposal methods). Let's simply assume that the part
8797 not covered by a sub-image is in the frame's background color. */
8798 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8799 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8800 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8801 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8803 for (y
= 0; y
< image_top
; ++y
)
8804 for (x
= 0; x
< width
; ++x
)
8805 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8807 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8808 for (x
= 0; x
< width
; ++x
)
8809 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8811 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8813 for (x
= 0; x
< image_left
; ++x
)
8814 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8815 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8816 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8819 /* Read the GIF image into the X image. We use a local variable
8820 `raster' here because RasterBits below is a char *, and invites
8821 problems with bytes >= 0x80. */
8822 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
8824 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8826 static int interlace_start
[] = {0, 4, 2, 1};
8827 static int interlace_increment
[] = {8, 8, 4, 2};
8829 int row
= interlace_start
[0];
8833 for (y
= 0; y
< image_height
; y
++)
8835 if (row
>= image_height
)
8837 row
= interlace_start
[++pass
];
8838 while (row
>= image_height
)
8839 row
= interlace_start
[++pass
];
8842 for (x
= 0; x
< image_width
; x
++)
8844 int i
= raster
[(y
* image_width
) + x
];
8845 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8849 row
+= interlace_increment
[pass
];
8854 for (y
= 0; y
< image_height
; ++y
)
8855 for (x
= 0; x
< image_width
; ++x
)
8857 int i
= raster
[y
* image_width
+ x
];
8858 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8862 DGifCloseFile (gif
);
8864 /* Put the image into the pixmap, then free the X image and its buffer. */
8865 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8866 x_destroy_x_image (ximg
);
8873 #endif /* HAVE_GIF != 0 */
8877 /***********************************************************************
8879 ***********************************************************************/
8881 static int gs_image_p
P_ ((Lisp_Object object
));
8882 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8883 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8885 /* The symbol `postscript' identifying images of this type. */
8887 Lisp_Object Qpostscript
;
8889 /* Keyword symbols. */
8891 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
8893 /* Indices of image specification fields in gs_format, below. */
8895 enum gs_keyword_index
8911 /* Vector of image_keyword structures describing the format
8912 of valid user-defined image specifications. */
8914 static struct image_keyword gs_format
[GS_LAST
] =
8916 {":type", IMAGE_SYMBOL_VALUE
, 1},
8917 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
8918 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
8919 {":file", IMAGE_STRING_VALUE
, 1},
8920 {":loader", IMAGE_FUNCTION_VALUE
, 0},
8921 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
8922 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8923 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8924 {":relief", IMAGE_INTEGER_VALUE
, 0},
8925 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8926 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8929 /* Structure describing the image type `ghostscript'. */
8931 static struct image_type gs_type
=
8941 /* Free X resources of Ghostscript image IMG which is used on frame F. */
8944 gs_clear_image (f
, img
)
8948 /* IMG->data.ptr_val may contain a recorded colormap. */
8949 xfree (img
->data
.ptr_val
);
8950 x_clear_image (f
, img
);
8954 /* Return non-zero if OBJECT is a valid Ghostscript image
8961 struct image_keyword fmt
[GS_LAST
];
8965 bcopy (gs_format
, fmt
, sizeof fmt
);
8967 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
8968 || (fmt
[GS_ASCENT
].count
8969 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
8972 /* Bounding box must be a list or vector containing 4 integers. */
8973 tem
= fmt
[GS_BOUNDING_BOX
].value
;
8976 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
8977 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
8982 else if (VECTORP (tem
))
8984 if (XVECTOR (tem
)->size
!= 4)
8986 for (i
= 0; i
< 4; ++i
)
8987 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
8997 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9006 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9007 struct gcpro gcpro1
, gcpro2
;
9009 double in_width
, in_height
;
9010 Lisp_Object pixel_colors
= Qnil
;
9012 /* Compute pixel size of pixmap needed from the given size in the
9013 image specification. Sizes in the specification are in pt. 1 pt
9014 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9016 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9017 in_width
= XFASTINT (pt_width
) / 72.0;
9018 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9019 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9020 in_height
= XFASTINT (pt_height
) / 72.0;
9021 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9023 /* Create the pixmap. */
9025 xassert (img
->pixmap
== 0);
9026 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9027 img
->width
, img
->height
,
9028 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9033 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9037 /* Call the loader to fill the pixmap. It returns a process object
9038 if successful. We do not record_unwind_protect here because
9039 other places in redisplay like calling window scroll functions
9040 don't either. Let the Lisp loader use `unwind-protect' instead. */
9041 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9043 sprintf (buffer
, "%lu %lu",
9044 (unsigned long) FRAME_X_WINDOW (f
),
9045 (unsigned long) img
->pixmap
);
9046 window_and_pixmap_id
= build_string (buffer
);
9048 sprintf (buffer
, "%lu %lu",
9049 FRAME_FOREGROUND_PIXEL (f
),
9050 FRAME_BACKGROUND_PIXEL (f
));
9051 pixel_colors
= build_string (buffer
);
9053 XSETFRAME (frame
, f
);
9054 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9056 loader
= intern ("gs-load-image");
9058 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9059 make_number (img
->width
),
9060 make_number (img
->height
),
9061 window_and_pixmap_id
,
9064 return PROCESSP (img
->data
.lisp_val
);
9068 /* Kill the Ghostscript process that was started to fill PIXMAP on
9069 frame F. Called from XTread_socket when receiving an event
9070 telling Emacs that Ghostscript has finished drawing. */
9073 x_kill_gs_process (pixmap
, f
)
9077 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9081 /* Find the image containing PIXMAP. */
9082 for (i
= 0; i
< c
->used
; ++i
)
9083 if (c
->images
[i
]->pixmap
== pixmap
)
9086 /* Kill the GS process. We should have found PIXMAP in the image
9087 cache and its image should contain a process object. */
9088 xassert (i
< c
->used
);
9090 xassert (PROCESSP (img
->data
.lisp_val
));
9091 Fkill_process (img
->data
.lisp_val
, Qnil
);
9092 img
->data
.lisp_val
= Qnil
;
9094 /* On displays with a mutable colormap, figure out the colors
9095 allocated for the image by looking at the pixels of an XImage for
9097 class = FRAME_X_VISUAL (f
)->class;
9098 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9104 /* Try to get an XImage for img->pixmep. */
9105 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9106 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9111 /* Initialize the color table. */
9112 init_color_table ();
9114 /* For each pixel of the image, look its color up in the
9115 color table. After having done so, the color table will
9116 contain an entry for each color used by the image. */
9117 for (y
= 0; y
< img
->height
; ++y
)
9118 for (x
= 0; x
< img
->width
; ++x
)
9120 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9121 lookup_pixel_color (f
, pixel
);
9124 /* Record colors in the image. Free color table and XImage. */
9125 img
->colors
= colors_in_color_table (&img
->ncolors
);
9126 free_color_table ();
9127 XDestroyImage (ximg
);
9129 #if 0 /* This doesn't seem to be the case. If we free the colors
9130 here, we get a BadAccess later in x_clear_image when
9131 freeing the colors. */
9132 /* We have allocated colors once, but Ghostscript has also
9133 allocated colors on behalf of us. So, to get the
9134 reference counts right, free them once. */
9136 x_free_colors (f
, img
->colors
, img
->ncolors
);
9140 image_error ("Cannot get X image of `%s'; colors will not be freed",
9149 /***********************************************************************
9151 ***********************************************************************/
9153 DEFUN ("x-change-window-property", Fx_change_window_property
,
9154 Sx_change_window_property
, 2, 3, 0,
9155 "Change window property PROP to VALUE on the X window of FRAME.\n\
9156 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9157 selected frame. Value is VALUE.")
9158 (prop
, value
, frame
)
9159 Lisp_Object frame
, prop
, value
;
9161 struct frame
*f
= check_x_frame (frame
);
9164 CHECK_STRING (prop
, 1);
9165 CHECK_STRING (value
, 2);
9168 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9169 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9170 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9171 XSTRING (value
)->data
, XSTRING (value
)->size
);
9173 /* Make sure the property is set when we return. */
9174 XFlush (FRAME_X_DISPLAY (f
));
9181 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9182 Sx_delete_window_property
, 1, 2, 0,
9183 "Remove window property PROP from X window of FRAME.\n\
9184 FRAME nil or omitted means use the selected frame. Value is PROP.")
9186 Lisp_Object prop
, frame
;
9188 struct frame
*f
= check_x_frame (frame
);
9191 CHECK_STRING (prop
, 1);
9193 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9194 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9196 /* Make sure the property is removed when we return. */
9197 XFlush (FRAME_X_DISPLAY (f
));
9204 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9206 "Value is the value of window property PROP on FRAME.\n\
9207 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9208 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9211 Lisp_Object prop
, frame
;
9213 struct frame
*f
= check_x_frame (frame
);
9216 Lisp_Object prop_value
= Qnil
;
9217 char *tmp_data
= NULL
;
9220 unsigned long actual_size
, bytes_remaining
;
9222 CHECK_STRING (prop
, 1);
9224 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9225 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9226 prop_atom
, 0, 0, False
, XA_STRING
,
9227 &actual_type
, &actual_format
, &actual_size
,
9228 &bytes_remaining
, (unsigned char **) &tmp_data
);
9231 int size
= bytes_remaining
;
9236 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9237 prop_atom
, 0, bytes_remaining
,
9239 &actual_type
, &actual_format
,
9240 &actual_size
, &bytes_remaining
,
9241 (unsigned char **) &tmp_data
);
9243 prop_value
= make_string (tmp_data
, size
);
9254 /***********************************************************************
9256 ***********************************************************************/
9258 /* If non-null, an asynchronous timer that, when it expires, displays
9259 a busy cursor on all frames. */
9261 static struct atimer
*busy_cursor_atimer
;
9263 /* Non-zero means a busy cursor is currently shown. */
9265 static int busy_cursor_shown_p
;
9267 /* Number of seconds to wait before displaying a busy cursor. */
9269 static Lisp_Object Vbusy_cursor_delay
;
9271 /* Default number of seconds to wait before displaying a busy
9274 #define DEFAULT_BUSY_CURSOR_DELAY 1
9276 /* Function prototypes. */
9278 static void show_busy_cursor
P_ ((struct atimer
*));
9279 static void hide_busy_cursor
P_ ((void));
9282 /* Cancel a currently active busy-cursor timer, and start a new one. */
9285 start_busy_cursor ()
9288 int secs
, usecs
= 0;
9290 cancel_busy_cursor ();
9292 if (INTEGERP (Vbusy_cursor_delay
)
9293 && XINT (Vbusy_cursor_delay
) > 0)
9294 secs
= XFASTINT (Vbusy_cursor_delay
);
9295 else if (FLOATP (Vbusy_cursor_delay
)
9296 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
9299 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
9300 secs
= XFASTINT (tem
);
9301 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
9304 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
9306 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
9307 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
9308 show_busy_cursor
, NULL
);
9312 /* Cancel the busy cursor timer if active, hide a busy cursor if
9316 cancel_busy_cursor ()
9318 if (busy_cursor_atimer
)
9320 cancel_atimer (busy_cursor_atimer
);
9321 busy_cursor_atimer
= NULL
;
9324 if (busy_cursor_shown_p
)
9325 hide_busy_cursor ();
9329 /* Timer function of busy_cursor_atimer. TIMER is equal to
9332 Display a busy cursor on all frames by mapping the frames'
9333 busy_window. Set the busy_p flag in the frames' output_data.x
9334 structure to indicate that a busy cursor is shown on the
9338 show_busy_cursor (timer
)
9339 struct atimer
*timer
;
9341 /* The timer implementation will cancel this timer automatically
9342 after this function has run. Set busy_cursor_atimer to null
9343 so that we know the timer doesn't have to be canceled. */
9344 busy_cursor_atimer
= NULL
;
9346 if (!busy_cursor_shown_p
)
9348 Lisp_Object rest
, frame
;
9352 FOR_EACH_FRAME (rest
, frame
)
9353 if (FRAME_X_P (XFRAME (frame
)))
9355 struct frame
*f
= XFRAME (frame
);
9357 f
->output_data
.x
->busy_p
= 1;
9359 if (!f
->output_data
.x
->busy_window
)
9361 unsigned long mask
= CWCursor
;
9362 XSetWindowAttributes attrs
;
9364 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9366 f
->output_data
.x
->busy_window
9367 = XCreateWindow (FRAME_X_DISPLAY (f
),
9368 FRAME_OUTER_WINDOW (f
),
9369 0, 0, 32000, 32000, 0, 0,
9375 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9376 XFlush (FRAME_X_DISPLAY (f
));
9379 busy_cursor_shown_p
= 1;
9385 /* Hide the busy cursor on all frames, if it is currently shown. */
9390 if (busy_cursor_shown_p
)
9392 Lisp_Object rest
, frame
;
9395 FOR_EACH_FRAME (rest
, frame
)
9397 struct frame
*f
= XFRAME (frame
);
9400 /* Watch out for newly created frames. */
9401 && f
->output_data
.x
->busy_window
)
9403 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9404 /* Sync here because XTread_socket looks at the busy_p flag
9405 that is reset to zero below. */
9406 XSync (FRAME_X_DISPLAY (f
), False
);
9407 f
->output_data
.x
->busy_p
= 0;
9411 busy_cursor_shown_p
= 0;
9418 /***********************************************************************
9420 ***********************************************************************/
9422 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9425 /* The frame of a currently visible tooltip, or null. */
9427 struct frame
*tip_frame
;
9429 /* If non-nil, a timer started that hides the last tooltip when it
9432 Lisp_Object tip_timer
;
9435 /* Create a frame for a tooltip on the display described by DPYINFO.
9436 PARMS is a list of frame parameters. Value is the frame. */
9439 x_create_tip_frame (dpyinfo
, parms
)
9440 struct x_display_info
*dpyinfo
;
9444 Lisp_Object frame
, tem
;
9446 long window_prompting
= 0;
9448 int count
= specpdl_ptr
- specpdl
;
9449 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9454 /* Use this general default value to start with until we know if
9455 this frame has a specified name. */
9456 Vx_resource_name
= Vinvocation_name
;
9459 kb
= dpyinfo
->kboard
;
9461 kb
= &the_only_kboard
;
9464 /* Get the name of the frame to use for resource lookup. */
9465 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9467 && !EQ (name
, Qunbound
)
9469 error ("Invalid frame name--not a string or nil");
9470 Vx_resource_name
= name
;
9473 GCPRO3 (parms
, name
, frame
);
9474 tip_frame
= f
= make_frame (1);
9475 XSETFRAME (frame
, f
);
9476 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9478 f
->output_method
= output_x_window
;
9479 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9480 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9481 f
->output_data
.x
->icon_bitmap
= -1;
9482 f
->output_data
.x
->fontset
= -1;
9483 f
->icon_name
= Qnil
;
9484 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9486 FRAME_KBOARD (f
) = kb
;
9488 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9489 f
->output_data
.x
->explicit_parent
= 0;
9491 /* Set the name; the functions to which we pass f expect the name to
9493 if (EQ (name
, Qunbound
) || NILP (name
))
9495 f
->name
= build_string (dpyinfo
->x_id_name
);
9496 f
->explicit_name
= 0;
9501 f
->explicit_name
= 1;
9502 /* use the frame's title when getting resources for this frame. */
9503 specbind (Qx_resource_name
, name
);
9506 /* Extract the window parameters from the supplied values
9507 that are needed to determine window geometry. */
9511 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9514 /* First, try whatever font the caller has specified. */
9517 tem
= Fquery_fontset (font
, Qnil
);
9519 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9521 font
= x_new_font (f
, XSTRING (font
)->data
);
9524 /* Try out a font which we hope has bold and italic variations. */
9525 if (!STRINGP (font
))
9526 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9527 if (!STRINGP (font
))
9528 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9529 if (! STRINGP (font
))
9530 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9531 if (! STRINGP (font
))
9532 /* This was formerly the first thing tried, but it finds too many fonts
9533 and takes too long. */
9534 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9535 /* If those didn't work, look for something which will at least work. */
9536 if (! STRINGP (font
))
9537 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9539 if (! STRINGP (font
))
9540 font
= build_string ("fixed");
9542 x_default_parameter (f
, parms
, Qfont
, font
,
9543 "font", "Font", RES_TYPE_STRING
);
9546 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9547 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9549 /* This defaults to 2 in order to match xterm. We recognize either
9550 internalBorderWidth or internalBorder (which is what xterm calls
9552 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9556 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9557 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9558 if (! EQ (value
, Qunbound
))
9559 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9563 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9564 "internalBorderWidth", "internalBorderWidth",
9567 /* Also do the stuff which must be set before the window exists. */
9568 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9569 "foreground", "Foreground", RES_TYPE_STRING
);
9570 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9571 "background", "Background", RES_TYPE_STRING
);
9572 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9573 "pointerColor", "Foreground", RES_TYPE_STRING
);
9574 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9575 "cursorColor", "Foreground", RES_TYPE_STRING
);
9576 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9577 "borderColor", "BorderColor", RES_TYPE_STRING
);
9579 /* Init faces before x_default_parameter is called for scroll-bar
9580 parameters because that function calls x_set_scroll_bar_width,
9581 which calls change_frame_size, which calls Fset_window_buffer,
9582 which runs hooks, which call Fvertical_motion. At the end, we
9583 end up in init_iterator with a null face cache, which should not
9585 init_frame_faces (f
);
9587 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9588 window_prompting
= x_figure_window_size (f
, parms
);
9590 if (window_prompting
& XNegative
)
9592 if (window_prompting
& YNegative
)
9593 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9595 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9599 if (window_prompting
& YNegative
)
9600 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9602 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9605 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9607 XSetWindowAttributes attrs
;
9611 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9612 /* Window managers look at the override-redirect flag to determine
9613 whether or net to give windows a decoration (Xlib spec, chapter
9615 attrs
.override_redirect
= True
;
9616 attrs
.save_under
= True
;
9617 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9618 /* Arrange for getting MapNotify and UnmapNotify events. */
9619 attrs
.event_mask
= StructureNotifyMask
;
9621 = FRAME_X_WINDOW (f
)
9622 = XCreateWindow (FRAME_X_DISPLAY (f
),
9623 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9624 /* x, y, width, height */
9628 CopyFromParent
, InputOutput
, CopyFromParent
,
9635 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9636 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9637 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9638 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9639 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9640 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9642 /* Dimensions, especially f->height, must be done via change_frame_size.
9643 Change will not be effected unless different from the current
9648 SET_FRAME_WIDTH (f
, 0);
9649 change_frame_size (f
, height
, width
, 1, 0, 0);
9655 /* It is now ok to make the frame official even if we get an error
9656 below. And the frame needs to be on Vframe_list or making it
9657 visible won't work. */
9658 Vframe_list
= Fcons (frame
, Vframe_list
);
9660 /* Now that the frame is official, it counts as a reference to
9662 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9664 return unbind_to (count
, frame
);
9668 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9669 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9670 A tooltip window is a small X window displaying STRING at\n\
9671 the current mouse position.\n\
9672 FRAME nil or omitted means use the selected frame.\n\
9673 PARMS is an optional list of frame parameters which can be\n\
9674 used to change the tooltip's appearance.\n\
9675 Automatically hide the tooltip after TIMEOUT seconds.\n\
9676 TIMEOUT nil means use the default timeout of 5 seconds.")
9677 (string
, frame
, parms
, timeout
)
9678 Lisp_Object string
, frame
, parms
, timeout
;
9684 struct buffer
*old_buffer
;
9685 struct text_pos pos
;
9686 int i
, width
, height
;
9687 int root_x
, root_y
, win_x
, win_y
;
9689 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
9690 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9691 int count
= specpdl_ptr
- specpdl
;
9693 specbind (Qinhibit_redisplay
, Qt
);
9695 GCPRO4 (string
, parms
, frame
, timeout
);
9697 CHECK_STRING (string
, 0);
9698 f
= check_x_frame (frame
);
9700 timeout
= make_number (5);
9702 CHECK_NATNUM (timeout
, 2);
9704 /* Hide a previous tip, if any. */
9707 /* Add default values to frame parameters. */
9708 if (NILP (Fassq (Qname
, parms
)))
9709 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9710 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9711 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9712 if (NILP (Fassq (Qborder_width
, parms
)))
9713 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9714 if (NILP (Fassq (Qborder_color
, parms
)))
9715 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9716 if (NILP (Fassq (Qbackground_color
, parms
)))
9717 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9720 /* Create a frame for the tooltip, and record it in the global
9721 variable tip_frame. */
9722 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9723 tip_frame
= f
= XFRAME (frame
);
9725 /* Set up the frame's root window. Currently we use a size of 80
9726 columns x 40 lines. If someone wants to show a larger tip, he
9727 will loose. I don't think this is a realistic case. */
9728 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9729 w
->left
= w
->top
= make_number (0);
9733 w
->pseudo_window_p
= 1;
9735 /* Display the tooltip text in a temporary buffer. */
9736 buffer
= Fget_buffer_create (build_string (" *tip*"));
9737 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9738 old_buffer
= current_buffer
;
9739 set_buffer_internal_1 (XBUFFER (buffer
));
9741 Finsert (make_number (1), &string
);
9742 clear_glyph_matrix (w
->desired_matrix
);
9743 clear_glyph_matrix (w
->current_matrix
);
9744 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9745 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9747 /* Compute width and height of the tooltip. */
9749 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9751 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9755 /* Stop at the first empty row at the end. */
9756 if (!row
->enabled_p
|| !row
->displays_text_p
)
9759 /* Let the row go over the full width of the frame. */
9760 row
->full_width_p
= 1;
9762 /* There's a glyph at the end of rows that is used to place
9763 the cursor there. Don't include the width of this glyph. */
9764 if (row
->used
[TEXT_AREA
])
9766 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9767 row_width
= row
->pixel_width
- last
->pixel_width
;
9770 row_width
= row
->pixel_width
;
9772 height
+= row
->height
;
9773 width
= max (width
, row_width
);
9776 /* Add the frame's internal border to the width and height the X
9777 window should have. */
9778 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9779 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9781 /* Move the tooltip window where the mouse pointer is. Resize and
9784 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9785 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9786 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9787 root_x
+ 5, root_y
- height
- 5, width
, height
);
9788 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9791 /* Draw into the window. */
9792 w
->must_be_updated_p
= 1;
9793 update_single_window (w
, 1);
9795 /* Restore original current buffer. */
9796 set_buffer_internal_1 (old_buffer
);
9797 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9799 /* Let the tip disappear after timeout seconds. */
9800 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9801 intern ("x-hide-tip"));
9804 return unbind_to (count
, Qnil
);
9808 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9809 "Hide the current tooltip window, if there is any.\n\
9810 Value is t is tooltip was open, nil otherwise.")
9813 int count
= specpdl_ptr
- specpdl
;
9816 specbind (Qinhibit_redisplay
, Qt
);
9818 if (!NILP (tip_timer
))
9820 call1 (intern ("cancel-timer"), tip_timer
);
9828 XSETFRAME (frame
, tip_frame
);
9829 Fdelete_frame (frame
, Qt
);
9834 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9839 /***********************************************************************
9840 File selection dialog
9841 ***********************************************************************/
9845 /* Callback for "OK" and "Cancel" on file selection dialog. */
9848 file_dialog_cb (widget
, client_data
, call_data
)
9850 XtPointer call_data
, client_data
;
9852 int *result
= (int *) client_data
;
9853 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9854 *result
= cb
->reason
;
9858 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9859 "Read file name, prompting with PROMPT in directory DIR.\n\
9860 Use a file selection dialog.\n\
9861 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9862 specified. Don't let the user enter a file name in the file\n\
9863 selection dialog's entry field, if MUSTMATCH is non-nil.")
9864 (prompt
, dir
, default_filename
, mustmatch
)
9865 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9868 struct frame
*f
= SELECTED_FRAME ();
9869 Lisp_Object file
= Qnil
;
9870 Widget dialog
, text
, list
, help
;
9873 extern XtAppContext Xt_app_con
;
9875 XmString dir_xmstring
, pattern_xmstring
;
9876 int popup_activated_flag
;
9877 int count
= specpdl_ptr
- specpdl
;
9878 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9880 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9881 CHECK_STRING (prompt
, 0);
9882 CHECK_STRING (dir
, 1);
9884 /* Prevent redisplay. */
9885 specbind (Qinhibit_redisplay
, Qt
);
9889 /* Create the dialog with PROMPT as title, using DIR as initial
9890 directory and using "*" as pattern. */
9891 dir
= Fexpand_file_name (dir
, Qnil
);
9892 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9893 pattern_xmstring
= XmStringCreateLocalized ("*");
9895 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9896 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9897 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9898 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9899 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9900 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9902 XmStringFree (dir_xmstring
);
9903 XmStringFree (pattern_xmstring
);
9905 /* Add callbacks for OK and Cancel. */
9906 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9907 (XtPointer
) &result
);
9908 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9909 (XtPointer
) &result
);
9911 /* Disable the help button since we can't display help. */
9912 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9913 XtSetSensitive (help
, False
);
9915 /* Mark OK button as default. */
9916 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
9917 XmNshowAsDefault
, True
, NULL
);
9919 /* If MUSTMATCH is non-nil, disable the file entry field of the
9920 dialog, so that the user must select a file from the files list
9921 box. We can't remove it because we wouldn't have a way to get at
9922 the result file name, then. */
9923 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
9924 if (!NILP (mustmatch
))
9927 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
9928 XtSetSensitive (text
, False
);
9929 XtSetSensitive (label
, False
);
9932 /* Manage the dialog, so that list boxes get filled. */
9933 XtManageChild (dialog
);
9935 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
9936 must include the path for this to work. */
9937 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
9938 if (STRINGP (default_filename
))
9940 XmString default_xmstring
;
9944 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
9946 if (!XmListItemExists (list
, default_xmstring
))
9948 /* Add a new item if DEFAULT_FILENAME is not in the list. */
9949 XmListAddItem (list
, default_xmstring
, 0);
9953 item_pos
= XmListItemPos (list
, default_xmstring
);
9954 XmStringFree (default_xmstring
);
9956 /* Select the item and scroll it into view. */
9957 XmListSelectPos (list
, item_pos
, True
);
9958 XmListSetPos (list
, item_pos
);
9961 /* Process all events until the user presses Cancel or OK. */
9962 for (result
= 0; result
== 0;)
9965 Widget widget
, parent
;
9967 XtAppNextEvent (Xt_app_con
, &event
);
9969 /* See if the receiver of the event is one of the widgets of
9970 the file selection dialog. If so, dispatch it. If not,
9972 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
9974 while (parent
&& parent
!= dialog
)
9975 parent
= XtParent (parent
);
9977 if (parent
== dialog
9978 || (event
.type
== Expose
9979 && !process_expose_from_menu (event
)))
9980 XtDispatchEvent (&event
);
9983 /* Get the result. */
9984 if (result
== XmCR_OK
)
9989 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
9990 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
9991 XmStringFree (text
);
9992 file
= build_string (data
);
9999 XtUnmanageChild (dialog
);
10000 XtDestroyWidget (dialog
);
10004 /* Make "Cancel" equivalent to C-g. */
10006 Fsignal (Qquit
, Qnil
);
10008 return unbind_to (count
, file
);
10011 #endif /* USE_MOTIF */
10014 /***********************************************************************
10016 ***********************************************************************/
10020 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10021 "Value is non-nil if SPEC is a valid image specification.")
10025 return valid_image_p (spec
) ? Qt
: Qnil
;
10029 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10035 if (valid_image_p (spec
))
10036 id
= lookup_image (SELECTED_FRAME (), spec
);
10038 debug_print (spec
);
10039 return make_number (id
);
10042 #endif /* GLYPH_DEBUG != 0 */
10046 /***********************************************************************
10048 ***********************************************************************/
10053 /* This is zero if not using X windows. */
10056 /* The section below is built by the lisp expression at the top of the file,
10057 just above where these variables are declared. */
10058 /*&&& init symbols here &&&*/
10059 Qauto_raise
= intern ("auto-raise");
10060 staticpro (&Qauto_raise
);
10061 Qauto_lower
= intern ("auto-lower");
10062 staticpro (&Qauto_lower
);
10063 Qbar
= intern ("bar");
10065 Qborder_color
= intern ("border-color");
10066 staticpro (&Qborder_color
);
10067 Qborder_width
= intern ("border-width");
10068 staticpro (&Qborder_width
);
10069 Qbox
= intern ("box");
10071 Qcursor_color
= intern ("cursor-color");
10072 staticpro (&Qcursor_color
);
10073 Qcursor_type
= intern ("cursor-type");
10074 staticpro (&Qcursor_type
);
10075 Qgeometry
= intern ("geometry");
10076 staticpro (&Qgeometry
);
10077 Qicon_left
= intern ("icon-left");
10078 staticpro (&Qicon_left
);
10079 Qicon_top
= intern ("icon-top");
10080 staticpro (&Qicon_top
);
10081 Qicon_type
= intern ("icon-type");
10082 staticpro (&Qicon_type
);
10083 Qicon_name
= intern ("icon-name");
10084 staticpro (&Qicon_name
);
10085 Qinternal_border_width
= intern ("internal-border-width");
10086 staticpro (&Qinternal_border_width
);
10087 Qleft
= intern ("left");
10088 staticpro (&Qleft
);
10089 Qright
= intern ("right");
10090 staticpro (&Qright
);
10091 Qmouse_color
= intern ("mouse-color");
10092 staticpro (&Qmouse_color
);
10093 Qnone
= intern ("none");
10094 staticpro (&Qnone
);
10095 Qparent_id
= intern ("parent-id");
10096 staticpro (&Qparent_id
);
10097 Qscroll_bar_width
= intern ("scroll-bar-width");
10098 staticpro (&Qscroll_bar_width
);
10099 Qsuppress_icon
= intern ("suppress-icon");
10100 staticpro (&Qsuppress_icon
);
10101 Qundefined_color
= intern ("undefined-color");
10102 staticpro (&Qundefined_color
);
10103 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10104 staticpro (&Qvertical_scroll_bars
);
10105 Qvisibility
= intern ("visibility");
10106 staticpro (&Qvisibility
);
10107 Qwindow_id
= intern ("window-id");
10108 staticpro (&Qwindow_id
);
10109 Qouter_window_id
= intern ("outer-window-id");
10110 staticpro (&Qouter_window_id
);
10111 Qx_frame_parameter
= intern ("x-frame-parameter");
10112 staticpro (&Qx_frame_parameter
);
10113 Qx_resource_name
= intern ("x-resource-name");
10114 staticpro (&Qx_resource_name
);
10115 Quser_position
= intern ("user-position");
10116 staticpro (&Quser_position
);
10117 Quser_size
= intern ("user-size");
10118 staticpro (&Quser_size
);
10119 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10120 staticpro (&Qscroll_bar_foreground
);
10121 Qscroll_bar_background
= intern ("scroll-bar-background");
10122 staticpro (&Qscroll_bar_background
);
10123 Qscreen_gamma
= intern ("screen-gamma");
10124 staticpro (&Qscreen_gamma
);
10125 /* This is the end of symbol initialization. */
10127 /* Text property `display' should be nonsticky by default. */
10128 Vtext_property_default_nonsticky
10129 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10132 Qlaplace
= intern ("laplace");
10133 staticpro (&Qlaplace
);
10135 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10136 staticpro (&Qface_set_after_frame_default
);
10138 Fput (Qundefined_color
, Qerror_conditions
,
10139 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10140 Fput (Qundefined_color
, Qerror_message
,
10141 build_string ("Undefined color"));
10143 init_x_parm_symbols ();
10145 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10146 "List of directories to search for bitmap files for X.");
10147 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10149 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10150 "The shape of the pointer when over text.\n\
10151 Changing the value does not affect existing frames\n\
10152 unless you set the mouse color.");
10153 Vx_pointer_shape
= Qnil
;
10155 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10156 "The name Emacs uses to look up X resources.\n\
10157 `x-get-resource' uses this as the first component of the instance name\n\
10158 when requesting resource values.\n\
10159 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10160 was invoked, or to the value specified with the `-name' or `-rn'\n\
10161 switches, if present.\n\
10163 It may be useful to bind this variable locally around a call\n\
10164 to `x-get-resource'. See also the variable `x-resource-class'.");
10165 Vx_resource_name
= Qnil
;
10167 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10168 "The class Emacs uses to look up X resources.\n\
10169 `x-get-resource' uses this as the first component of the instance class\n\
10170 when requesting resource values.\n\
10171 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10173 Setting this variable permanently is not a reasonable thing to do,\n\
10174 but binding this variable locally around a call to `x-get-resource'\n\
10175 is a reasonable practice. See also the variable `x-resource-name'.");
10176 Vx_resource_class
= build_string (EMACS_CLASS
);
10178 #if 0 /* This doesn't really do anything. */
10179 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10180 "The shape of the pointer when not over text.\n\
10181 This variable takes effect when you create a new frame\n\
10182 or when you set the mouse color.");
10184 Vx_nontext_pointer_shape
= Qnil
;
10186 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10187 "The shape of the pointer when Emacs is busy.\n\
10188 This variable takes effect when you create a new frame\n\
10189 or when you set the mouse color.");
10190 Vx_busy_pointer_shape
= Qnil
;
10192 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10193 "Non-zero means Emacs displays a busy cursor on window systems.");
10194 display_busy_cursor_p
= 1;
10196 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10197 "*Seconds to wait before displaying a busy-cursor.\n\
10198 Value must be an integer or float.");
10199 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10201 #if 0 /* This doesn't really do anything. */
10202 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10203 "The shape of the pointer when over the mode line.\n\
10204 This variable takes effect when you create a new frame\n\
10205 or when you set the mouse color.");
10207 Vx_mode_pointer_shape
= Qnil
;
10209 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10210 &Vx_sensitive_text_pointer_shape
,
10211 "The shape of the pointer when over mouse-sensitive text.\n\
10212 This variable takes effect when you create a new frame\n\
10213 or when you set the mouse color.");
10214 Vx_sensitive_text_pointer_shape
= Qnil
;
10216 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10217 "A string indicating the foreground color of the cursor box.");
10218 Vx_cursor_fore_pixel
= Qnil
;
10220 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10221 "Non-nil if no X window manager is in use.\n\
10222 Emacs doesn't try to figure this out; this is always nil\n\
10223 unless you set it to something else.");
10224 /* We don't have any way to find this out, so set it to nil
10225 and maybe the user would like to set it to t. */
10226 Vx_no_window_manager
= Qnil
;
10228 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10229 &Vx_pixel_size_width_font_regexp
,
10230 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10232 Since Emacs gets width of a font matching with this regexp from\n\
10233 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10234 such a font. This is especially effective for such large fonts as\n\
10235 Chinese, Japanese, and Korean.");
10236 Vx_pixel_size_width_font_regexp
= Qnil
;
10238 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10239 "Time after which cached images are removed from the cache.\n\
10240 When an image has not been displayed this many seconds, remove it\n\
10241 from the image cache. Value must be an integer or nil with nil\n\
10242 meaning don't clear the cache.");
10243 Vimage_cache_eviction_delay
= make_number (30 * 60);
10245 DEFVAR_LISP ("image-types", &Vimage_types
,
10246 "List of supported image types.\n\
10247 Each element of the list is a symbol for a supported image type.");
10248 Vimage_types
= Qnil
;
10250 #ifdef USE_X_TOOLKIT
10251 Fprovide (intern ("x-toolkit"));
10254 Fprovide (intern ("motif"));
10257 defsubr (&Sx_get_resource
);
10259 /* X window properties. */
10260 defsubr (&Sx_change_window_property
);
10261 defsubr (&Sx_delete_window_property
);
10262 defsubr (&Sx_window_property
);
10264 defsubr (&Sxw_display_color_p
);
10265 defsubr (&Sx_display_grayscale_p
);
10266 defsubr (&Sxw_color_defined_p
);
10267 defsubr (&Sxw_color_values
);
10268 defsubr (&Sx_server_max_request_size
);
10269 defsubr (&Sx_server_vendor
);
10270 defsubr (&Sx_server_version
);
10271 defsubr (&Sx_display_pixel_width
);
10272 defsubr (&Sx_display_pixel_height
);
10273 defsubr (&Sx_display_mm_width
);
10274 defsubr (&Sx_display_mm_height
);
10275 defsubr (&Sx_display_screens
);
10276 defsubr (&Sx_display_planes
);
10277 defsubr (&Sx_display_color_cells
);
10278 defsubr (&Sx_display_visual_class
);
10279 defsubr (&Sx_display_backing_store
);
10280 defsubr (&Sx_display_save_under
);
10281 defsubr (&Sx_parse_geometry
);
10282 defsubr (&Sx_create_frame
);
10283 defsubr (&Sx_open_connection
);
10284 defsubr (&Sx_close_connection
);
10285 defsubr (&Sx_display_list
);
10286 defsubr (&Sx_synchronize
);
10287 defsubr (&Sx_focus_frame
);
10289 /* Setting callback functions for fontset handler. */
10290 get_font_info_func
= x_get_font_info
;
10292 #if 0 /* This function pointer doesn't seem to be used anywhere.
10293 And the pointer assigned has the wrong type, anyway. */
10294 list_fonts_func
= x_list_fonts
;
10297 load_font_func
= x_load_font
;
10298 find_ccl_program_func
= x_find_ccl_program
;
10299 query_font_func
= x_query_font
;
10300 set_frame_fontset_func
= x_set_font
;
10301 check_window_system_func
= check_x
;
10304 Qxbm
= intern ("xbm");
10306 QCtype
= intern (":type");
10307 staticpro (&QCtype
);
10308 QCalgorithm
= intern (":algorithm");
10309 staticpro (&QCalgorithm
);
10310 QCheuristic_mask
= intern (":heuristic-mask");
10311 staticpro (&QCheuristic_mask
);
10312 QCcolor_symbols
= intern (":color-symbols");
10313 staticpro (&QCcolor_symbols
);
10314 QCascent
= intern (":ascent");
10315 staticpro (&QCascent
);
10316 QCmargin
= intern (":margin");
10317 staticpro (&QCmargin
);
10318 QCrelief
= intern (":relief");
10319 staticpro (&QCrelief
);
10320 Qpostscript
= intern ("postscript");
10321 staticpro (&Qpostscript
);
10322 QCloader
= intern (":loader");
10323 staticpro (&QCloader
);
10324 QCbounding_box
= intern (":bounding-box");
10325 staticpro (&QCbounding_box
);
10326 QCpt_width
= intern (":pt-width");
10327 staticpro (&QCpt_width
);
10328 QCpt_height
= intern (":pt-height");
10329 staticpro (&QCpt_height
);
10330 QCindex
= intern (":index");
10331 staticpro (&QCindex
);
10332 Qpbm
= intern ("pbm");
10336 Qxpm
= intern ("xpm");
10341 Qjpeg
= intern ("jpeg");
10342 staticpro (&Qjpeg
);
10346 Qtiff
= intern ("tiff");
10347 staticpro (&Qtiff
);
10351 Qgif
= intern ("gif");
10356 Qpng
= intern ("png");
10360 defsubr (&Sclear_image_cache
);
10363 defsubr (&Simagep
);
10364 defsubr (&Slookup_image
);
10367 busy_cursor_atimer
= NULL
;
10368 busy_cursor_shown_p
= 0;
10370 defsubr (&Sx_show_tip
);
10371 defsubr (&Sx_hide_tip
);
10372 staticpro (&tip_timer
);
10376 defsubr (&Sx_file_dialog
);
10384 image_types
= NULL
;
10385 Vimage_types
= Qnil
;
10387 define_image_type (&xbm_type
);
10388 define_image_type (&gs_type
);
10389 define_image_type (&pbm_type
);
10392 define_image_type (&xpm_type
);
10396 define_image_type (&jpeg_type
);
10400 define_image_type (&tiff_type
);
10404 define_image_type (&gif_type
);
10408 define_image_type (&png_type
);
10412 #endif /* HAVE_X_WINDOWS */