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
;
1524 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1525 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1526 WHITE_PIX_DEFAULT (f
));
1528 fore_pixel
= f
->output_data
.x
->background_pixel
;
1529 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1531 /* Make sure that the cursor color differs from the background color. */
1532 if (pixel
== f
->output_data
.x
->background_pixel
)
1534 pixel
= f
->output_data
.x
->mouse_pixel
;
1535 if (pixel
== fore_pixel
)
1536 fore_pixel
= f
->output_data
.x
->background_pixel
;
1539 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1540 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1542 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1543 f
->output_data
.x
->cursor_pixel
= pixel
;
1545 if (FRAME_X_WINDOW (f
) != 0)
1548 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1549 f
->output_data
.x
->cursor_pixel
);
1550 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1554 if (FRAME_VISIBLE_P (f
))
1556 x_update_cursor (f
, 0);
1557 x_update_cursor (f
, 1);
1561 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1564 /* Set the border-color of frame F to value described by ARG.
1565 ARG can be a string naming a color.
1566 The border-color is used for the border that is drawn by the X server.
1567 Note that this does not fully take effect if done before
1568 F has an x-window; it must be redone when the window is created.
1570 Note: this is done in two routines because of the way X10 works.
1572 Note: under X11, this is normally the province of the window manager,
1573 and so emacs' border colors may be overridden. */
1576 x_set_border_color (f
, arg
, oldval
)
1578 Lisp_Object arg
, oldval
;
1582 CHECK_STRING (arg
, 0);
1583 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1584 x_set_border_pixel (f
, pix
);
1585 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1588 /* Set the border-color of frame F to pixel value PIX.
1589 Note that this does not fully take effect if done before
1590 F has an x-window. */
1593 x_set_border_pixel (f
, pix
)
1597 unload_color (f
, f
->output_data
.x
->border_pixel
);
1598 f
->output_data
.x
->border_pixel
= pix
;
1600 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1603 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1604 (unsigned long)pix
);
1607 if (FRAME_VISIBLE_P (f
))
1613 x_set_cursor_type (f
, arg
, oldval
)
1615 Lisp_Object arg
, oldval
;
1619 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1620 f
->output_data
.x
->cursor_width
= 2;
1622 else if (CONSP (arg
)
1623 && EQ (XCAR (arg
), Qbar
)
1624 && INTEGERP (XCDR (arg
))
1625 && XINT (XCDR (arg
)) >= 0)
1627 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1628 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1630 else if (NILP (arg
))
1631 FRAME_DESIRED_CURSOR (f
) = NO_CURSOR
;
1633 /* Treat anything unknown as "box cursor".
1634 It was bad to signal an error; people have trouble fixing
1635 .Xdefaults with Emacs, when it has something bad in it. */
1636 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1638 /* Make sure the cursor gets redrawn. This is overkill, but how
1639 often do people change cursor types? */
1640 update_mode_lines
++;
1644 x_set_icon_type (f
, arg
, oldval
)
1646 Lisp_Object arg
, oldval
;
1652 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1655 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1660 result
= x_text_icon (f
,
1661 (char *) XSTRING ((!NILP (f
->icon_name
)
1665 result
= x_bitmap_icon (f
, arg
);
1670 error ("No icon window available");
1673 XFlush (FRAME_X_DISPLAY (f
));
1677 /* Return non-nil if frame F wants a bitmap icon. */
1685 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1693 x_set_icon_name (f
, arg
, oldval
)
1695 Lisp_Object arg
, oldval
;
1701 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1704 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1709 if (f
->output_data
.x
->icon_bitmap
!= 0)
1714 result
= x_text_icon (f
,
1715 (char *) XSTRING ((!NILP (f
->icon_name
)
1724 error ("No icon window available");
1727 XFlush (FRAME_X_DISPLAY (f
));
1732 x_set_font (f
, arg
, oldval
)
1734 Lisp_Object arg
, oldval
;
1737 Lisp_Object fontset_name
;
1740 CHECK_STRING (arg
, 1);
1742 fontset_name
= Fquery_fontset (arg
, Qnil
);
1745 result
= (STRINGP (fontset_name
)
1746 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1747 : x_new_font (f
, XSTRING (arg
)->data
));
1750 if (EQ (result
, Qnil
))
1751 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1752 else if (EQ (result
, Qt
))
1753 error ("The characters of the given font have varying widths");
1754 else if (STRINGP (result
))
1756 store_frame_param (f
, Qfont
, result
);
1757 recompute_basic_faces (f
);
1762 do_pending_window_change (0);
1764 /* Don't call `face-set-after-frame-default' when faces haven't been
1765 initialized yet. This is the case when called from
1766 Fx_create_frame. In that case, the X widget or window doesn't
1767 exist either, and we can end up in x_report_frame_params with a
1768 null widget which gives a segfault. */
1769 if (FRAME_FACE_CACHE (f
))
1771 XSETFRAME (frame
, f
);
1772 call1 (Qface_set_after_frame_default
, frame
);
1777 x_set_border_width (f
, arg
, oldval
)
1779 Lisp_Object arg
, oldval
;
1781 CHECK_NUMBER (arg
, 0);
1783 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1786 if (FRAME_X_WINDOW (f
) != 0)
1787 error ("Cannot change the border width of a window");
1789 f
->output_data
.x
->border_width
= XINT (arg
);
1793 x_set_internal_border_width (f
, arg
, oldval
)
1795 Lisp_Object arg
, oldval
;
1797 int old
= f
->output_data
.x
->internal_border_width
;
1799 CHECK_NUMBER (arg
, 0);
1800 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1801 if (f
->output_data
.x
->internal_border_width
< 0)
1802 f
->output_data
.x
->internal_border_width
= 0;
1804 #ifdef USE_X_TOOLKIT
1805 if (f
->output_data
.x
->edit_widget
)
1806 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1809 if (f
->output_data
.x
->internal_border_width
== old
)
1812 if (FRAME_X_WINDOW (f
) != 0)
1814 x_set_window_size (f
, 0, f
->width
, f
->height
);
1815 SET_FRAME_GARBAGED (f
);
1816 do_pending_window_change (0);
1821 x_set_visibility (f
, value
, oldval
)
1823 Lisp_Object value
, oldval
;
1826 XSETFRAME (frame
, f
);
1829 Fmake_frame_invisible (frame
, Qt
);
1830 else if (EQ (value
, Qicon
))
1831 Ficonify_frame (frame
);
1833 Fmake_frame_visible (frame
);
1837 x_set_menu_bar_lines_1 (window
, n
)
1841 struct window
*w
= XWINDOW (window
);
1843 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1844 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1846 if (INTEGERP (w
->orig_top
))
1847 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1848 if (INTEGERP (w
->orig_height
))
1849 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1851 /* Handle just the top child in a vertical split. */
1852 if (!NILP (w
->vchild
))
1853 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1855 /* Adjust all children in a horizontal split. */
1856 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1858 w
= XWINDOW (window
);
1859 x_set_menu_bar_lines_1 (window
, n
);
1864 x_set_menu_bar_lines (f
, value
, oldval
)
1866 Lisp_Object value
, oldval
;
1869 #ifndef USE_X_TOOLKIT
1870 int olines
= FRAME_MENU_BAR_LINES (f
);
1873 /* Right now, menu bars don't work properly in minibuf-only frames;
1874 most of the commands try to apply themselves to the minibuffer
1875 frame itself, and get an error because you can't switch buffers
1876 in or split the minibuffer window. */
1877 if (FRAME_MINIBUF_ONLY_P (f
))
1880 if (INTEGERP (value
))
1881 nlines
= XINT (value
);
1885 /* Make sure we redisplay all windows in this frame. */
1886 windows_or_buffers_changed
++;
1888 #ifdef USE_X_TOOLKIT
1889 FRAME_MENU_BAR_LINES (f
) = 0;
1892 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1893 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1894 /* Make sure next redisplay shows the menu bar. */
1895 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1899 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1900 free_frame_menubar (f
);
1901 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1903 f
->output_data
.x
->menubar_widget
= 0;
1905 #else /* not USE_X_TOOLKIT */
1906 FRAME_MENU_BAR_LINES (f
) = nlines
;
1907 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1908 #endif /* not USE_X_TOOLKIT */
1913 /* Set the number of lines used for the tool bar of frame F to VALUE.
1914 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1915 is the old number of tool bar lines. This function changes the
1916 height of all windows on frame F to match the new tool bar height.
1917 The frame's height doesn't change. */
1920 x_set_tool_bar_lines (f
, value
, oldval
)
1922 Lisp_Object value
, oldval
;
1926 /* Use VALUE only if an integer >= 0. */
1927 if (INTEGERP (value
) && XINT (value
) >= 0)
1928 nlines
= XFASTINT (value
);
1932 /* Make sure we redisplay all windows in this frame. */
1933 ++windows_or_buffers_changed
;
1935 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1936 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1937 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
1942 /* Set the foreground color for scroll bars on frame F to VALUE.
1943 VALUE should be a string, a color name. If it isn't a string or
1944 isn't a valid color name, do nothing. OLDVAL is the old value of
1945 the frame parameter. */
1948 x_set_scroll_bar_foreground (f
, value
, oldval
)
1950 Lisp_Object value
, oldval
;
1952 unsigned long pixel
;
1954 if (STRINGP (value
))
1955 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
1959 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
1960 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
1962 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
1963 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
1965 /* Remove all scroll bars because they have wrong colors. */
1966 if (condemn_scroll_bars_hook
)
1967 (*condemn_scroll_bars_hook
) (f
);
1968 if (judge_scroll_bars_hook
)
1969 (*judge_scroll_bars_hook
) (f
);
1971 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
1977 /* Set the background color for scroll bars on frame F to VALUE VALUE
1978 should be a string, a color name. If it isn't a string or isn't a
1979 valid color name, do nothing. OLDVAL is the old value of the frame
1983 x_set_scroll_bar_background (f
, value
, oldval
)
1985 Lisp_Object value
, oldval
;
1987 unsigned long pixel
;
1989 if (STRINGP (value
))
1990 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
1994 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
1995 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
1997 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
1998 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2000 /* Remove all scroll bars because they have wrong colors. */
2001 if (condemn_scroll_bars_hook
)
2002 (*condemn_scroll_bars_hook
) (f
);
2003 if (judge_scroll_bars_hook
)
2004 (*judge_scroll_bars_hook
) (f
);
2006 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2012 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2015 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2016 name; if NAME is a string, set F's name to NAME and set
2017 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2019 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2020 suggesting a new name, which lisp code should override; if
2021 F->explicit_name is set, ignore the new name; otherwise, set it. */
2024 x_set_name (f
, name
, explicit)
2029 /* Make sure that requests from lisp code override requests from
2030 Emacs redisplay code. */
2033 /* If we're switching from explicit to implicit, we had better
2034 update the mode lines and thereby update the title. */
2035 if (f
->explicit_name
&& NILP (name
))
2036 update_mode_lines
= 1;
2038 f
->explicit_name
= ! NILP (name
);
2040 else if (f
->explicit_name
)
2043 /* If NAME is nil, set the name to the x_id_name. */
2046 /* Check for no change needed in this very common case
2047 before we do any consing. */
2048 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2049 XSTRING (f
->name
)->data
))
2051 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2054 CHECK_STRING (name
, 0);
2056 /* Don't change the name if it's already NAME. */
2057 if (! NILP (Fstring_equal (name
, f
->name
)))
2062 /* For setting the frame title, the title parameter should override
2063 the name parameter. */
2064 if (! NILP (f
->title
))
2067 if (FRAME_X_WINDOW (f
))
2072 XTextProperty text
, icon
;
2073 Lisp_Object icon_name
;
2075 text
.value
= XSTRING (name
)->data
;
2076 text
.encoding
= XA_STRING
;
2078 text
.nitems
= STRING_BYTES (XSTRING (name
));
2080 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2082 icon
.value
= XSTRING (icon_name
)->data
;
2083 icon
.encoding
= XA_STRING
;
2085 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2086 #ifdef USE_X_TOOLKIT
2087 XSetWMName (FRAME_X_DISPLAY (f
),
2088 XtWindow (f
->output_data
.x
->widget
), &text
);
2089 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2091 #else /* not USE_X_TOOLKIT */
2092 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2093 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2094 #endif /* not USE_X_TOOLKIT */
2096 #else /* not HAVE_X11R4 */
2097 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2098 XSTRING (name
)->data
);
2099 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2100 XSTRING (name
)->data
);
2101 #endif /* not HAVE_X11R4 */
2106 /* This function should be called when the user's lisp code has
2107 specified a name for the frame; the name will override any set by the
2110 x_explicitly_set_name (f
, arg
, oldval
)
2112 Lisp_Object arg
, oldval
;
2114 x_set_name (f
, arg
, 1);
2117 /* This function should be called by Emacs redisplay code to set the
2118 name; names set this way will never override names set by the user's
2121 x_implicitly_set_name (f
, arg
, oldval
)
2123 Lisp_Object arg
, oldval
;
2125 x_set_name (f
, arg
, 0);
2128 /* Change the title of frame F to NAME.
2129 If NAME is nil, use the frame name as the title.
2131 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2132 name; if NAME is a string, set F's name to NAME and set
2133 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2135 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2136 suggesting a new name, which lisp code should override; if
2137 F->explicit_name is set, ignore the new name; otherwise, set it. */
2140 x_set_title (f
, name
, old_name
)
2142 Lisp_Object name
, old_name
;
2144 /* Don't change the title if it's already NAME. */
2145 if (EQ (name
, f
->title
))
2148 update_mode_lines
= 1;
2155 CHECK_STRING (name
, 0);
2157 if (FRAME_X_WINDOW (f
))
2162 XTextProperty text
, icon
;
2163 Lisp_Object icon_name
;
2165 text
.value
= XSTRING (name
)->data
;
2166 text
.encoding
= XA_STRING
;
2168 text
.nitems
= STRING_BYTES (XSTRING (name
));
2170 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2172 icon
.value
= XSTRING (icon_name
)->data
;
2173 icon
.encoding
= XA_STRING
;
2175 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2176 #ifdef USE_X_TOOLKIT
2177 XSetWMName (FRAME_X_DISPLAY (f
),
2178 XtWindow (f
->output_data
.x
->widget
), &text
);
2179 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2181 #else /* not USE_X_TOOLKIT */
2182 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2183 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2184 #endif /* not USE_X_TOOLKIT */
2186 #else /* not HAVE_X11R4 */
2187 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2188 XSTRING (name
)->data
);
2189 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2190 XSTRING (name
)->data
);
2191 #endif /* not HAVE_X11R4 */
2197 x_set_autoraise (f
, arg
, oldval
)
2199 Lisp_Object arg
, oldval
;
2201 f
->auto_raise
= !EQ (Qnil
, arg
);
2205 x_set_autolower (f
, arg
, oldval
)
2207 Lisp_Object arg
, oldval
;
2209 f
->auto_lower
= !EQ (Qnil
, arg
);
2213 x_set_unsplittable (f
, arg
, oldval
)
2215 Lisp_Object arg
, oldval
;
2217 f
->no_split
= !NILP (arg
);
2221 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2223 Lisp_Object arg
, oldval
;
2225 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2226 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2227 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2228 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2230 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2232 ? vertical_scroll_bar_none
2234 ? vertical_scroll_bar_right
2235 : vertical_scroll_bar_left
);
2237 /* We set this parameter before creating the X window for the
2238 frame, so we can get the geometry right from the start.
2239 However, if the window hasn't been created yet, we shouldn't
2240 call x_set_window_size. */
2241 if (FRAME_X_WINDOW (f
))
2242 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2243 do_pending_window_change (0);
2248 x_set_scroll_bar_width (f
, arg
, oldval
)
2250 Lisp_Object arg
, oldval
;
2252 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2256 #ifdef USE_TOOLKIT_SCROLL_BARS
2257 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2258 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2259 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2260 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2262 /* Make the actual width at least 14 pixels and a multiple of a
2264 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2266 /* Use all of that space (aside from required margins) for the
2268 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2271 if (FRAME_X_WINDOW (f
))
2272 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2273 do_pending_window_change (0);
2275 else if (INTEGERP (arg
) && XINT (arg
) > 0
2276 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2278 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2279 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2281 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2282 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2283 if (FRAME_X_WINDOW (f
))
2284 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2287 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2288 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2289 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2294 /* Subroutines of creating an X frame. */
2296 /* Make sure that Vx_resource_name is set to a reasonable value.
2297 Fix it up, or set it to `emacs' if it is too hopeless. */
2300 validate_x_resource_name ()
2303 /* Number of valid characters in the resource name. */
2305 /* Number of invalid characters in the resource name. */
2310 if (!STRINGP (Vx_resource_class
))
2311 Vx_resource_class
= build_string (EMACS_CLASS
);
2313 if (STRINGP (Vx_resource_name
))
2315 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2318 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2320 /* Only letters, digits, - and _ are valid in resource names.
2321 Count the valid characters and count the invalid ones. */
2322 for (i
= 0; i
< len
; i
++)
2325 if (! ((c
>= 'a' && c
<= 'z')
2326 || (c
>= 'A' && c
<= 'Z')
2327 || (c
>= '0' && c
<= '9')
2328 || c
== '-' || c
== '_'))
2335 /* Not a string => completely invalid. */
2336 bad_count
= 5, good_count
= 0;
2338 /* If name is valid already, return. */
2342 /* If name is entirely invalid, or nearly so, use `emacs'. */
2344 || (good_count
== 1 && bad_count
> 0))
2346 Vx_resource_name
= build_string ("emacs");
2350 /* Name is partly valid. Copy it and replace the invalid characters
2351 with underscores. */
2353 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2355 for (i
= 0; i
< len
; i
++)
2357 int c
= XSTRING (new)->data
[i
];
2358 if (! ((c
>= 'a' && c
<= 'z')
2359 || (c
>= 'A' && c
<= 'Z')
2360 || (c
>= '0' && c
<= '9')
2361 || c
== '-' || c
== '_'))
2362 XSTRING (new)->data
[i
] = '_';
2367 extern char *x_get_string_resource ();
2369 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2370 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2371 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2372 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2373 the name specified by the `-name' or `-rn' command-line arguments.\n\
2375 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2376 class, respectively. You must specify both of them or neither.\n\
2377 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2378 and the class is `Emacs.CLASS.SUBCLASS'.")
2379 (attribute
, class, component
, subclass
)
2380 Lisp_Object attribute
, class, component
, subclass
;
2382 register char *value
;
2388 CHECK_STRING (attribute
, 0);
2389 CHECK_STRING (class, 0);
2391 if (!NILP (component
))
2392 CHECK_STRING (component
, 1);
2393 if (!NILP (subclass
))
2394 CHECK_STRING (subclass
, 2);
2395 if (NILP (component
) != NILP (subclass
))
2396 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2398 validate_x_resource_name ();
2400 /* Allocate space for the components, the dots which separate them,
2401 and the final '\0'. Make them big enough for the worst case. */
2402 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2403 + (STRINGP (component
)
2404 ? STRING_BYTES (XSTRING (component
)) : 0)
2405 + STRING_BYTES (XSTRING (attribute
))
2408 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2409 + STRING_BYTES (XSTRING (class))
2410 + (STRINGP (subclass
)
2411 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2414 /* Start with emacs.FRAMENAME for the name (the specific one)
2415 and with `Emacs' for the class key (the general one). */
2416 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2417 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2419 strcat (class_key
, ".");
2420 strcat (class_key
, XSTRING (class)->data
);
2422 if (!NILP (component
))
2424 strcat (class_key
, ".");
2425 strcat (class_key
, XSTRING (subclass
)->data
);
2427 strcat (name_key
, ".");
2428 strcat (name_key
, XSTRING (component
)->data
);
2431 strcat (name_key
, ".");
2432 strcat (name_key
, XSTRING (attribute
)->data
);
2434 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2435 name_key
, class_key
);
2437 if (value
!= (char *) 0)
2438 return build_string (value
);
2443 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2446 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2447 struct x_display_info
*dpyinfo
;
2448 Lisp_Object attribute
, class, component
, subclass
;
2450 register char *value
;
2454 CHECK_STRING (attribute
, 0);
2455 CHECK_STRING (class, 0);
2457 if (!NILP (component
))
2458 CHECK_STRING (component
, 1);
2459 if (!NILP (subclass
))
2460 CHECK_STRING (subclass
, 2);
2461 if (NILP (component
) != NILP (subclass
))
2462 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2464 validate_x_resource_name ();
2466 /* Allocate space for the components, the dots which separate them,
2467 and the final '\0'. Make them big enough for the worst case. */
2468 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2469 + (STRINGP (component
)
2470 ? STRING_BYTES (XSTRING (component
)) : 0)
2471 + STRING_BYTES (XSTRING (attribute
))
2474 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2475 + STRING_BYTES (XSTRING (class))
2476 + (STRINGP (subclass
)
2477 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2480 /* Start with emacs.FRAMENAME for the name (the specific one)
2481 and with `Emacs' for the class key (the general one). */
2482 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2483 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2485 strcat (class_key
, ".");
2486 strcat (class_key
, XSTRING (class)->data
);
2488 if (!NILP (component
))
2490 strcat (class_key
, ".");
2491 strcat (class_key
, XSTRING (subclass
)->data
);
2493 strcat (name_key
, ".");
2494 strcat (name_key
, XSTRING (component
)->data
);
2497 strcat (name_key
, ".");
2498 strcat (name_key
, XSTRING (attribute
)->data
);
2500 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2502 if (value
!= (char *) 0)
2503 return build_string (value
);
2508 /* Used when C code wants a resource value. */
2511 x_get_resource_string (attribute
, class)
2512 char *attribute
, *class;
2516 struct frame
*sf
= SELECTED_FRAME ();
2518 /* Allocate space for the components, the dots which separate them,
2519 and the final '\0'. */
2520 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2521 + strlen (attribute
) + 2);
2522 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2523 + strlen (class) + 2);
2525 sprintf (name_key
, "%s.%s",
2526 XSTRING (Vinvocation_name
)->data
,
2528 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2530 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2531 name_key
, class_key
);
2534 /* Types we might convert a resource string into. */
2544 /* Return the value of parameter PARAM.
2546 First search ALIST, then Vdefault_frame_alist, then the X defaults
2547 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2549 Convert the resource to the type specified by desired_type.
2551 If no default is specified, return Qunbound. If you call
2552 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2553 and don't let it get stored in any Lisp-visible variables! */
2556 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2557 struct x_display_info
*dpyinfo
;
2558 Lisp_Object alist
, param
;
2561 enum resource_types type
;
2563 register Lisp_Object tem
;
2565 tem
= Fassq (param
, alist
);
2567 tem
= Fassq (param
, Vdefault_frame_alist
);
2573 tem
= display_x_get_resource (dpyinfo
,
2574 build_string (attribute
),
2575 build_string (class),
2583 case RES_TYPE_NUMBER
:
2584 return make_number (atoi (XSTRING (tem
)->data
));
2586 case RES_TYPE_FLOAT
:
2587 return make_float (atof (XSTRING (tem
)->data
));
2589 case RES_TYPE_BOOLEAN
:
2590 tem
= Fdowncase (tem
);
2591 if (!strcmp (XSTRING (tem
)->data
, "on")
2592 || !strcmp (XSTRING (tem
)->data
, "true"))
2597 case RES_TYPE_STRING
:
2600 case RES_TYPE_SYMBOL
:
2601 /* As a special case, we map the values `true' and `on'
2602 to Qt, and `false' and `off' to Qnil. */
2605 lower
= Fdowncase (tem
);
2606 if (!strcmp (XSTRING (lower
)->data
, "on")
2607 || !strcmp (XSTRING (lower
)->data
, "true"))
2609 else if (!strcmp (XSTRING (lower
)->data
, "off")
2610 || !strcmp (XSTRING (lower
)->data
, "false"))
2613 return Fintern (tem
, Qnil
);
2626 /* Like x_get_arg, but also record the value in f->param_alist. */
2629 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2631 Lisp_Object alist
, param
;
2634 enum resource_types type
;
2638 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2639 attribute
, class, type
);
2641 store_frame_param (f
, param
, value
);
2646 /* Record in frame F the specified or default value according to ALIST
2647 of the parameter named PROP (a Lisp symbol).
2648 If no value is specified for PROP, look for an X default for XPROP
2649 on the frame named NAME.
2650 If that is not found either, use the value DEFLT. */
2653 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2660 enum resource_types type
;
2664 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2665 if (EQ (tem
, Qunbound
))
2667 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2672 /* Record in frame F the specified or default value according to ALIST
2673 of the parameter named PROP (a Lisp symbol). If no value is
2674 specified for PROP, look for an X default for XPROP on the frame
2675 named NAME. If that is not found either, use the value DEFLT. */
2678 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2687 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2690 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2691 if (EQ (tem
, Qunbound
))
2693 #ifdef USE_TOOLKIT_SCROLL_BARS
2695 /* See if an X resource for the scroll bar color has been
2697 tem
= display_x_get_resource (dpyinfo
,
2698 build_string (foreground_p
2702 build_string ("verticalScrollBar"),
2706 /* If nothing has been specified, scroll bars will use a
2707 toolkit-dependent default. Because these defaults are
2708 difficult to get at without actually creating a scroll
2709 bar, use nil to indicate that no color has been
2714 #else /* not USE_TOOLKIT_SCROLL_BARS */
2718 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2721 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2727 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2728 "Parse an X-style geometry string STRING.\n\
2729 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2730 The properties returned may include `top', `left', `height', and `width'.\n\
2731 The value of `left' or `top' may be an integer,\n\
2732 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2733 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2738 unsigned int width
, height
;
2741 CHECK_STRING (string
, 0);
2743 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2744 &x
, &y
, &width
, &height
);
2747 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2748 error ("Must specify both x and y position, or neither");
2752 if (geometry
& XValue
)
2754 Lisp_Object element
;
2756 if (x
>= 0 && (geometry
& XNegative
))
2757 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2758 else if (x
< 0 && ! (geometry
& XNegative
))
2759 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2761 element
= Fcons (Qleft
, make_number (x
));
2762 result
= Fcons (element
, result
);
2765 if (geometry
& YValue
)
2767 Lisp_Object element
;
2769 if (y
>= 0 && (geometry
& YNegative
))
2770 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2771 else if (y
< 0 && ! (geometry
& YNegative
))
2772 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2774 element
= Fcons (Qtop
, make_number (y
));
2775 result
= Fcons (element
, result
);
2778 if (geometry
& WidthValue
)
2779 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2780 if (geometry
& HeightValue
)
2781 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2786 /* Calculate the desired size and position of this window,
2787 and return the flags saying which aspects were specified.
2789 This function does not make the coordinates positive. */
2791 #define DEFAULT_ROWS 40
2792 #define DEFAULT_COLS 80
2795 x_figure_window_size (f
, parms
)
2799 register Lisp_Object tem0
, tem1
, tem2
;
2800 long window_prompting
= 0;
2801 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2803 /* Default values if we fall through.
2804 Actually, if that happens we should get
2805 window manager prompting. */
2806 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2807 f
->height
= DEFAULT_ROWS
;
2808 /* Window managers expect that if program-specified
2809 positions are not (0,0), they're intentional, not defaults. */
2810 f
->output_data
.x
->top_pos
= 0;
2811 f
->output_data
.x
->left_pos
= 0;
2813 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2814 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2815 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2816 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2818 if (!EQ (tem0
, Qunbound
))
2820 CHECK_NUMBER (tem0
, 0);
2821 f
->height
= XINT (tem0
);
2823 if (!EQ (tem1
, Qunbound
))
2825 CHECK_NUMBER (tem1
, 0);
2826 SET_FRAME_WIDTH (f
, XINT (tem1
));
2828 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2829 window_prompting
|= USSize
;
2831 window_prompting
|= PSize
;
2834 f
->output_data
.x
->vertical_scroll_bar_extra
2835 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2837 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2838 f
->output_data
.x
->flags_areas_extra
2839 = FRAME_FLAGS_AREA_WIDTH (f
);
2840 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2841 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2843 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2844 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2845 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2846 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2848 if (EQ (tem0
, Qminus
))
2850 f
->output_data
.x
->top_pos
= 0;
2851 window_prompting
|= YNegative
;
2853 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2854 && CONSP (XCDR (tem0
))
2855 && INTEGERP (XCAR (XCDR (tem0
))))
2857 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2858 window_prompting
|= YNegative
;
2860 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2861 && CONSP (XCDR (tem0
))
2862 && INTEGERP (XCAR (XCDR (tem0
))))
2864 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2866 else if (EQ (tem0
, Qunbound
))
2867 f
->output_data
.x
->top_pos
= 0;
2870 CHECK_NUMBER (tem0
, 0);
2871 f
->output_data
.x
->top_pos
= XINT (tem0
);
2872 if (f
->output_data
.x
->top_pos
< 0)
2873 window_prompting
|= YNegative
;
2876 if (EQ (tem1
, Qminus
))
2878 f
->output_data
.x
->left_pos
= 0;
2879 window_prompting
|= XNegative
;
2881 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2882 && CONSP (XCDR (tem1
))
2883 && INTEGERP (XCAR (XCDR (tem1
))))
2885 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2886 window_prompting
|= XNegative
;
2888 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2889 && CONSP (XCDR (tem1
))
2890 && INTEGERP (XCAR (XCDR (tem1
))))
2892 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2894 else if (EQ (tem1
, Qunbound
))
2895 f
->output_data
.x
->left_pos
= 0;
2898 CHECK_NUMBER (tem1
, 0);
2899 f
->output_data
.x
->left_pos
= XINT (tem1
);
2900 if (f
->output_data
.x
->left_pos
< 0)
2901 window_prompting
|= XNegative
;
2904 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2905 window_prompting
|= USPosition
;
2907 window_prompting
|= PPosition
;
2910 return window_prompting
;
2913 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2916 XSetWMProtocols (dpy
, w
, protocols
, count
)
2923 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2924 if (prop
== None
) return False
;
2925 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2926 (unsigned char *) protocols
, count
);
2929 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2931 #ifdef USE_X_TOOLKIT
2933 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2934 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2935 already be present because of the toolkit (Motif adds some of them,
2936 for example, but Xt doesn't). */
2939 hack_wm_protocols (f
, widget
)
2943 Display
*dpy
= XtDisplay (widget
);
2944 Window w
= XtWindow (widget
);
2945 int need_delete
= 1;
2951 Atom type
, *atoms
= 0;
2953 unsigned long nitems
= 0;
2954 unsigned long bytes_after
;
2956 if ((XGetWindowProperty (dpy
, w
,
2957 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2958 (long)0, (long)100, False
, XA_ATOM
,
2959 &type
, &format
, &nitems
, &bytes_after
,
2960 (unsigned char **) &atoms
)
2962 && format
== 32 && type
== XA_ATOM
)
2966 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
2968 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
2970 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
2973 if (atoms
) XFree ((char *) atoms
);
2979 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
2981 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
2983 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
2985 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
2986 XA_ATOM
, 32, PropModeAppend
,
2987 (unsigned char *) props
, count
);
2995 /* Support routines for XIC (X Input Context). */
2999 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3000 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3003 /* Supported XIM styles, ordered by preferenc. */
3005 static XIMStyle supported_xim_styles
[] =
3007 XIMPreeditPosition
| XIMStatusArea
,
3008 XIMPreeditPosition
| XIMStatusNothing
,
3009 XIMPreeditPosition
| XIMStatusNone
,
3010 XIMPreeditNothing
| XIMStatusArea
,
3011 XIMPreeditNothing
| XIMStatusNothing
,
3012 XIMPreeditNothing
| XIMStatusNone
,
3013 XIMPreeditNone
| XIMStatusArea
,
3014 XIMPreeditNone
| XIMStatusNothing
,
3015 XIMPreeditNone
| XIMStatusNone
,
3020 /* Create an X fontset on frame F with base font name
3024 xic_create_xfontset (f
, base_fontname
)
3026 char *base_fontname
;
3029 char **missing_list
;
3033 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3034 base_fontname
, &missing_list
,
3035 &missing_count
, &def_string
);
3037 XFreeStringList (missing_list
);
3039 /* No need to free def_string. */
3044 /* Value is the best input style, given user preferences USER (already
3045 checked to be supported by Emacs), and styles supported by the
3046 input method XIM. */
3049 best_xim_style (user
, xim
)
3055 for (i
= 0; i
< user
->count_styles
; ++i
)
3056 for (j
= 0; j
< xim
->count_styles
; ++j
)
3057 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3058 return user
->supported_styles
[i
];
3060 /* Return the default style. */
3061 return XIMPreeditNothing
| XIMStatusNothing
;
3064 /* Create XIC for frame F. */
3067 create_frame_xic (f
)
3072 XFontSet xfs
= NULL
;
3073 static XIMStyle xic_style
;
3078 xim
= FRAME_X_XIM (f
);
3083 XVaNestedList preedit_attr
;
3084 XVaNestedList status_attr
;
3085 char *base_fontname
;
3088 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3089 spot
.x
= 0; spot
.y
= 1;
3090 /* Create X fontset. */
3091 fontset
= FRAME_FONTSET (f
);
3093 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3096 struct fontset_info
*fontsetp
;
3100 fontsetp
= FRAME_FONTSET_DATA (f
)->fontset_table
[fontset
];
3101 for (i
= 0; i
<= MAX_CHARSET
; i
++)
3102 if (fontsetp
->fontname
[i
])
3103 len
+= strlen (fontsetp
->fontname
[i
]) + 1;
3104 base_fontname
= alloca (len
);
3105 strcpy (base_fontname
, fontsetp
->fontname
[CHARSET_ASCII
]);
3106 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
<= MAX_CHARSET
; i
++)
3107 if (fontsetp
->fontname
[i
])
3109 strcat (base_fontname
, ",");
3110 strcat (base_fontname
, fontsetp
->fontname
[i
]);
3113 xfs
= xic_create_xfontset (f
, base_fontname
);
3115 /* Determine XIC style. */
3118 XIMStyles supported_list
;
3119 supported_list
.count_styles
= (sizeof supported_xim_styles
3120 / sizeof supported_xim_styles
[0]);
3121 supported_list
.supported_styles
= supported_xim_styles
;
3122 xic_style
= best_xim_style (&supported_list
,
3123 FRAME_X_XIM_STYLES (f
));
3126 preedit_attr
= XVaCreateNestedList (0,
3129 FRAME_FOREGROUND_PIXEL (f
),
3131 FRAME_BACKGROUND_PIXEL (f
),
3132 (xic_style
& XIMPreeditPosition
3137 status_attr
= XVaCreateNestedList (0,
3143 FRAME_FOREGROUND_PIXEL (f
),
3145 FRAME_BACKGROUND_PIXEL (f
),
3148 xic
= XCreateIC (xim
,
3149 XNInputStyle
, xic_style
,
3150 XNClientWindow
, FRAME_X_WINDOW(f
),
3151 XNFocusWindow
, FRAME_X_WINDOW(f
),
3152 XNStatusAttributes
, status_attr
,
3153 XNPreeditAttributes
, preedit_attr
,
3155 XFree (preedit_attr
);
3156 XFree (status_attr
);
3159 FRAME_XIC (f
) = xic
;
3160 FRAME_XIC_STYLE (f
) = xic_style
;
3161 FRAME_XIC_FONTSET (f
) = xfs
;
3165 /* Destroy XIC and free XIC fontset of frame F, if any. */
3171 if (FRAME_XIC (f
) == NULL
)
3174 XDestroyIC (FRAME_XIC (f
));
3175 if (FRAME_XIC_FONTSET (f
))
3176 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3178 FRAME_XIC (f
) = NULL
;
3179 FRAME_XIC_FONTSET (f
) = NULL
;
3183 /* Place preedit area for XIC of window W's frame to specified
3184 pixel position X/Y. X and Y are relative to window W. */
3187 xic_set_preeditarea (w
, x
, y
)
3191 struct frame
*f
= XFRAME (w
->frame
);
3195 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3196 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3197 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3198 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3203 /* Place status area for XIC in bottom right corner of frame F.. */
3206 xic_set_statusarea (f
)
3209 XIC xic
= FRAME_XIC (f
);
3214 /* Negotiate geometry of status area. If input method has existing
3215 status area, use its current size. */
3216 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3217 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3218 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3221 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3222 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3225 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3227 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3228 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3232 area
.width
= needed
->width
;
3233 area
.height
= needed
->height
;
3234 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3235 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3236 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3239 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3240 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3245 /* Set X fontset for XIC of frame F, using base font name
3246 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3249 xic_set_xfontset (f
, base_fontname
)
3251 char *base_fontname
;
3256 xfs
= xic_create_xfontset (f
, base_fontname
);
3258 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3259 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3260 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3261 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3262 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3265 if (FRAME_XIC_FONTSET (f
))
3266 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3267 FRAME_XIC_FONTSET (f
) = xfs
;
3270 #endif /* HAVE_X_I18N */
3274 #ifdef USE_X_TOOLKIT
3276 /* Create and set up the X widget for frame F. */
3279 x_window (f
, window_prompting
, minibuffer_only
)
3281 long window_prompting
;
3282 int minibuffer_only
;
3284 XClassHint class_hints
;
3285 XSetWindowAttributes attributes
;
3286 unsigned long attribute_mask
;
3287 Widget shell_widget
;
3289 Widget frame_widget
;
3295 /* Use the resource name as the top-level widget name
3296 for looking up resources. Make a non-Lisp copy
3297 for the window manager, so GC relocation won't bother it.
3299 Elsewhere we specify the window name for the window manager. */
3302 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3303 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3304 strcpy (f
->namebuf
, str
);
3308 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3309 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3310 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3311 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3312 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3313 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3314 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3315 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3316 applicationShellWidgetClass
,
3317 FRAME_X_DISPLAY (f
), al
, ac
);
3319 f
->output_data
.x
->widget
= shell_widget
;
3320 /* maybe_set_screen_title_format (shell_widget); */
3322 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3323 (widget_value
*) NULL
,
3324 shell_widget
, False
,
3328 (lw_callback
) NULL
);
3331 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3332 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3333 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3334 XtSetValues (pane_widget
, al
, ac
);
3335 f
->output_data
.x
->column_widget
= pane_widget
;
3337 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3338 the emacs screen when changing menubar. This reduces flickering. */
3341 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3342 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3343 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3344 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3345 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3346 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3347 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3348 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3349 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3352 f
->output_data
.x
->edit_widget
= frame_widget
;
3354 XtManageChild (frame_widget
);
3356 /* Do some needed geometry management. */
3359 char *tem
, shell_position
[32];
3362 int extra_borders
= 0;
3364 = (f
->output_data
.x
->menubar_widget
3365 ? (f
->output_data
.x
->menubar_widget
->core
.height
3366 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3369 #if 0 /* Experimentally, we now get the right results
3370 for -geometry -0-0 without this. 24 Aug 96, rms. */
3371 if (FRAME_EXTERNAL_MENU_BAR (f
))
3374 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3375 menubar_size
+= ibw
;
3379 f
->output_data
.x
->menubar_height
= menubar_size
;
3382 /* Motif seems to need this amount added to the sizes
3383 specified for the shell widget. The Athena/Lucid widgets don't.
3384 Both conclusions reached experimentally. -- rms. */
3385 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3386 &extra_borders
, NULL
);
3390 /* Convert our geometry parameters into a geometry string
3392 Note that we do not specify here whether the position
3393 is a user-specified or program-specified one.
3394 We pass that information later, in x_wm_set_size_hints. */
3396 int left
= f
->output_data
.x
->left_pos
;
3397 int xneg
= window_prompting
& XNegative
;
3398 int top
= f
->output_data
.x
->top_pos
;
3399 int yneg
= window_prompting
& YNegative
;
3405 if (window_prompting
& USPosition
)
3406 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3407 PIXEL_WIDTH (f
) + extra_borders
,
3408 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3409 (xneg
? '-' : '+'), left
,
3410 (yneg
? '-' : '+'), top
);
3412 sprintf (shell_position
, "=%dx%d",
3413 PIXEL_WIDTH (f
) + extra_borders
,
3414 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3417 len
= strlen (shell_position
) + 1;
3418 /* We don't free this because we don't know whether
3419 it is safe to free it while the frame exists.
3420 It isn't worth the trouble of arranging to free it
3421 when the frame is deleted. */
3422 tem
= (char *) xmalloc (len
);
3423 strncpy (tem
, shell_position
, len
);
3424 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3425 XtSetValues (shell_widget
, al
, ac
);
3428 XtManageChild (pane_widget
);
3429 XtRealizeWidget (shell_widget
);
3431 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3433 validate_x_resource_name ();
3435 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3436 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3437 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3440 FRAME_XIC (f
) = NULL
;
3441 create_frame_xic (f
);
3444 f
->output_data
.x
->wm_hints
.input
= True
;
3445 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3446 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3447 &f
->output_data
.x
->wm_hints
);
3449 hack_wm_protocols (f
, shell_widget
);
3452 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3455 /* Do a stupid property change to force the server to generate a
3456 PropertyNotify event so that the event_stream server timestamp will
3457 be initialized to something relevant to the time we created the window.
3459 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3460 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3461 XA_ATOM
, 32, PropModeAppend
,
3462 (unsigned char*) NULL
, 0);
3464 /* Make all the standard events reach the Emacs frame. */
3465 attributes
.event_mask
= STANDARD_EVENT_SET
;
3470 /* XIM server might require some X events. */
3471 unsigned long fevent
= NoEventMask
;
3472 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3473 attributes
.event_mask
|= fevent
;
3475 #endif /* HAVE_X_I18N */
3477 attribute_mask
= CWEventMask
;
3478 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3479 attribute_mask
, &attributes
);
3481 XtMapWidget (frame_widget
);
3483 /* x_set_name normally ignores requests to set the name if the
3484 requested name is the same as the current name. This is the one
3485 place where that assumption isn't correct; f->name is set, but
3486 the X server hasn't been told. */
3489 int explicit = f
->explicit_name
;
3491 f
->explicit_name
= 0;
3494 x_set_name (f
, name
, explicit);
3497 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3498 f
->output_data
.x
->text_cursor
);
3502 /* This is a no-op, except under Motif. Make sure main areas are
3503 set to something reasonable, in case we get an error later. */
3504 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3507 #else /* not USE_X_TOOLKIT */
3509 /* Create and set up the X window for frame F. */
3516 XClassHint class_hints
;
3517 XSetWindowAttributes attributes
;
3518 unsigned long attribute_mask
;
3520 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3521 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3522 attributes
.bit_gravity
= StaticGravity
;
3523 attributes
.backing_store
= NotUseful
;
3524 attributes
.save_under
= True
;
3525 attributes
.event_mask
= STANDARD_EVENT_SET
;
3526 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3527 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3532 = XCreateWindow (FRAME_X_DISPLAY (f
),
3533 f
->output_data
.x
->parent_desc
,
3534 f
->output_data
.x
->left_pos
,
3535 f
->output_data
.x
->top_pos
,
3536 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3537 f
->output_data
.x
->border_width
,
3538 CopyFromParent
, /* depth */
3539 InputOutput
, /* class */
3541 attribute_mask
, &attributes
);
3544 create_frame_xic (f
);
3547 /* XIM server might require some X events. */
3548 unsigned long fevent
= NoEventMask
;
3549 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3550 attributes
.event_mask
|= fevent
;
3551 attribute_mask
= CWEventMask
;
3552 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3553 attribute_mask
, &attributes
);
3555 #endif /* HAVE_X_I18N */
3557 validate_x_resource_name ();
3559 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3560 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3561 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3563 /* The menubar is part of the ordinary display;
3564 it does not count in addition to the height of the window. */
3565 f
->output_data
.x
->menubar_height
= 0;
3567 /* This indicates that we use the "Passive Input" input model.
3568 Unless we do this, we don't get the Focus{In,Out} events that we
3569 need to draw the cursor correctly. Accursed bureaucrats.
3570 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3572 f
->output_data
.x
->wm_hints
.input
= True
;
3573 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3574 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3575 &f
->output_data
.x
->wm_hints
);
3576 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3578 /* Request "save yourself" and "delete window" commands from wm. */
3581 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3582 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3583 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3586 /* x_set_name normally ignores requests to set the name if the
3587 requested name is the same as the current name. This is the one
3588 place where that assumption isn't correct; f->name is set, but
3589 the X server hasn't been told. */
3592 int explicit = f
->explicit_name
;
3594 f
->explicit_name
= 0;
3597 x_set_name (f
, name
, explicit);
3600 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3601 f
->output_data
.x
->text_cursor
);
3605 if (FRAME_X_WINDOW (f
) == 0)
3606 error ("Unable to create window");
3609 #endif /* not USE_X_TOOLKIT */
3611 /* Handle the icon stuff for this window. Perhaps later we might
3612 want an x_set_icon_position which can be called interactively as
3620 Lisp_Object icon_x
, icon_y
;
3621 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3623 /* Set the position of the icon. Note that twm groups all
3624 icons in an icon window. */
3625 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3626 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3627 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3629 CHECK_NUMBER (icon_x
, 0);
3630 CHECK_NUMBER (icon_y
, 0);
3632 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3633 error ("Both left and top icon corners of icon must be specified");
3637 if (! EQ (icon_x
, Qunbound
))
3638 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3640 /* Start up iconic or window? */
3641 x_wm_set_window_state
3642 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3647 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3654 /* Make the GC's needed for this window, setting the
3655 background, border and mouse colors; also create the
3656 mouse cursor and the gray border tile. */
3658 static char cursor_bits
[] =
3660 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3661 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3662 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3663 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3670 XGCValues gc_values
;
3674 /* Create the GC's of this frame.
3675 Note that many default values are used. */
3678 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3679 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3680 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3681 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3682 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3684 GCLineWidth
| GCFont
3685 | GCForeground
| GCBackground
,
3688 /* Reverse video style. */
3689 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3690 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3691 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3693 GCFont
| GCForeground
| GCBackground
3697 /* Cursor has cursor-color background, background-color foreground. */
3698 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3699 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3700 gc_values
.fill_style
= FillOpaqueStippled
;
3702 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3703 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3704 cursor_bits
, 16, 16);
3705 f
->output_data
.x
->cursor_gc
3706 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3707 (GCFont
| GCForeground
| GCBackground
3708 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3712 f
->output_data
.x
->white_relief
.gc
= 0;
3713 f
->output_data
.x
->black_relief
.gc
= 0;
3715 /* Create the gray border tile used when the pointer is not in
3716 the frame. Since this depends on the frame's pixel values,
3717 this must be done on a per-frame basis. */
3718 f
->output_data
.x
->border_tile
3719 = (XCreatePixmapFromBitmapData
3720 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3721 gray_bits
, gray_width
, gray_height
,
3722 f
->output_data
.x
->foreground_pixel
,
3723 f
->output_data
.x
->background_pixel
,
3724 DefaultDepth (FRAME_X_DISPLAY (f
),
3725 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3730 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3732 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3733 Returns an Emacs frame object.\n\
3734 ALIST is an alist of frame parameters.\n\
3735 If the parameters specify that the frame should not have a minibuffer,\n\
3736 and do not specify a specific minibuffer window to use,\n\
3737 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3738 be shared by the new frame.\n\
3740 This function is an internal primitive--use `make-frame' instead.")
3745 Lisp_Object frame
, tem
;
3747 int minibuffer_only
= 0;
3748 long window_prompting
= 0;
3750 int count
= specpdl_ptr
- specpdl
;
3751 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3752 Lisp_Object display
;
3753 struct x_display_info
*dpyinfo
= NULL
;
3759 /* Use this general default value to start with
3760 until we know if this frame has a specified name. */
3761 Vx_resource_name
= Vinvocation_name
;
3763 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3764 if (EQ (display
, Qunbound
))
3766 dpyinfo
= check_x_display_info (display
);
3768 kb
= dpyinfo
->kboard
;
3770 kb
= &the_only_kboard
;
3773 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3775 && ! EQ (name
, Qunbound
)
3777 error ("Invalid frame name--not a string or nil");
3780 Vx_resource_name
= name
;
3782 /* See if parent window is specified. */
3783 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3784 if (EQ (parent
, Qunbound
))
3786 if (! NILP (parent
))
3787 CHECK_NUMBER (parent
, 0);
3789 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3790 /* No need to protect DISPLAY because that's not used after passing
3791 it to make_frame_without_minibuffer. */
3793 GCPRO4 (parms
, parent
, name
, frame
);
3794 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3796 if (EQ (tem
, Qnone
) || NILP (tem
))
3797 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3798 else if (EQ (tem
, Qonly
))
3800 f
= make_minibuffer_frame ();
3801 minibuffer_only
= 1;
3803 else if (WINDOWP (tem
))
3804 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3808 XSETFRAME (frame
, f
);
3810 /* Note that X Windows does support scroll bars. */
3811 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3813 f
->output_method
= output_x_window
;
3814 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3815 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3816 f
->output_data
.x
->icon_bitmap
= -1;
3817 f
->output_data
.x
->fontset
= -1;
3818 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3819 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3822 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3824 if (! STRINGP (f
->icon_name
))
3825 f
->icon_name
= Qnil
;
3827 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3829 FRAME_KBOARD (f
) = kb
;
3832 /* These colors will be set anyway later, but it's important
3833 to get the color reference counts right, so initialize them! */
3836 struct gcpro gcpro1
;
3838 black
= build_string ("black");
3840 f
->output_data
.x
->foreground_pixel
3841 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3842 f
->output_data
.x
->background_pixel
3843 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3844 f
->output_data
.x
->cursor_pixel
3845 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3846 f
->output_data
.x
->cursor_foreground_pixel
3847 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3848 f
->output_data
.x
->border_pixel
3849 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3850 f
->output_data
.x
->mouse_pixel
3851 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3855 /* Specify the parent under which to make this X window. */
3859 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3860 f
->output_data
.x
->explicit_parent
= 1;
3864 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3865 f
->output_data
.x
->explicit_parent
= 0;
3868 /* Set the name; the functions to which we pass f expect the name to
3870 if (EQ (name
, Qunbound
) || NILP (name
))
3872 f
->name
= build_string (dpyinfo
->x_id_name
);
3873 f
->explicit_name
= 0;
3878 f
->explicit_name
= 1;
3879 /* use the frame's title when getting resources for this frame. */
3880 specbind (Qx_resource_name
, name
);
3883 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3884 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3885 fs_register_fontset (f
, XCAR (tem
));
3887 /* Extract the window parameters from the supplied values
3888 that are needed to determine window geometry. */
3892 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3895 /* First, try whatever font the caller has specified. */
3898 tem
= Fquery_fontset (font
, Qnil
);
3900 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3902 font
= x_new_font (f
, XSTRING (font
)->data
);
3905 /* Try out a font which we hope has bold and italic variations. */
3906 if (!STRINGP (font
))
3907 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3908 if (!STRINGP (font
))
3909 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3910 if (! STRINGP (font
))
3911 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3912 if (! STRINGP (font
))
3913 /* This was formerly the first thing tried, but it finds too many fonts
3914 and takes too long. */
3915 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3916 /* If those didn't work, look for something which will at least work. */
3917 if (! STRINGP (font
))
3918 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3920 if (! STRINGP (font
))
3921 font
= build_string ("fixed");
3923 x_default_parameter (f
, parms
, Qfont
, font
,
3924 "font", "Font", RES_TYPE_STRING
);
3928 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3929 whereby it fails to get any font. */
3930 xlwmenu_default_font
= f
->output_data
.x
->font
;
3933 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3934 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3936 /* This defaults to 2 in order to match xterm. We recognize either
3937 internalBorderWidth or internalBorder (which is what xterm calls
3939 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3943 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3944 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3945 if (! EQ (value
, Qunbound
))
3946 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3949 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3950 "internalBorderWidth", "internalBorderWidth",
3952 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3953 "verticalScrollBars", "ScrollBars",
3956 /* Also do the stuff which must be set before the window exists. */
3957 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3958 "foreground", "Foreground", RES_TYPE_STRING
);
3959 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3960 "background", "Background", RES_TYPE_STRING
);
3961 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3962 "pointerColor", "Foreground", RES_TYPE_STRING
);
3963 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3964 "cursorColor", "Foreground", RES_TYPE_STRING
);
3965 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3966 "borderColor", "BorderColor", RES_TYPE_STRING
);
3967 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3968 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3970 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3971 "scrollBarForeground",
3972 "ScrollBarForeground", 1);
3973 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3974 "scrollBarBackground",
3975 "ScrollBarBackground", 0);
3977 /* Init faces before x_default_parameter is called for scroll-bar
3978 parameters because that function calls x_set_scroll_bar_width,
3979 which calls change_frame_size, which calls Fset_window_buffer,
3980 which runs hooks, which call Fvertical_motion. At the end, we
3981 end up in init_iterator with a null face cache, which should not
3983 init_frame_faces (f
);
3985 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3986 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3987 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3988 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3989 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3990 "bufferPredicate", "BufferPredicate",
3992 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3993 "title", "Title", RES_TYPE_STRING
);
3995 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3996 window_prompting
= x_figure_window_size (f
, parms
);
3998 if (window_prompting
& XNegative
)
4000 if (window_prompting
& YNegative
)
4001 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4003 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4007 if (window_prompting
& YNegative
)
4008 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4010 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4013 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4015 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4016 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4018 /* Create the X widget or window. Add the tool-bar height to the
4019 initial frame height so that the user gets a text display area of
4020 the size he specified with -g or via .Xdefaults. Later changes
4021 of the tool-bar height don't change the frame size. This is done
4022 so that users can create tall Emacs frames without having to
4023 guess how tall the tool-bar will get. */
4024 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4026 #ifdef USE_X_TOOLKIT
4027 x_window (f
, window_prompting
, minibuffer_only
);
4035 /* Now consider the frame official. */
4036 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4037 Vframe_list
= Fcons (frame
, Vframe_list
);
4039 /* We need to do this after creating the X window, so that the
4040 icon-creation functions can say whose icon they're describing. */
4041 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4042 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4044 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4045 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4046 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4047 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4048 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4049 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4050 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4051 "scrollBarWidth", "ScrollBarWidth",
4054 /* Dimensions, especially f->height, must be done via change_frame_size.
4055 Change will not be effected unless different from the current
4060 SET_FRAME_WIDTH (f
, 0);
4061 change_frame_size (f
, height
, width
, 1, 0, 0);
4063 /* Set up faces after all frame parameters are known. */
4064 call1 (Qface_set_after_frame_default
, frame
);
4066 #ifdef USE_X_TOOLKIT
4067 /* Create the menu bar. */
4068 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4070 /* If this signals an error, we haven't set size hints for the
4071 frame and we didn't make it visible. */
4072 initialize_frame_menubar (f
);
4074 /* This is a no-op, except under Motif where it arranges the
4075 main window for the widgets on it. */
4076 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4077 f
->output_data
.x
->menubar_widget
,
4078 f
->output_data
.x
->edit_widget
);
4080 #endif /* USE_X_TOOLKIT */
4082 /* Tell the server what size and position, etc, we want, and how
4083 badly we want them. This should be done after we have the menu
4084 bar so that its size can be taken into account. */
4086 x_wm_set_size_hint (f
, window_prompting
, 0);
4089 /* Make the window appear on the frame and enable display, unless
4090 the caller says not to. However, with explicit parent, Emacs
4091 cannot control visibility, so don't try. */
4092 if (! f
->output_data
.x
->explicit_parent
)
4094 Lisp_Object visibility
;
4096 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4098 if (EQ (visibility
, Qunbound
))
4101 if (EQ (visibility
, Qicon
))
4102 x_iconify_frame (f
);
4103 else if (! NILP (visibility
))
4104 x_make_frame_visible (f
);
4106 /* Must have been Qnil. */
4111 return unbind_to (count
, frame
);
4114 /* FRAME is used only to get a handle on the X display. We don't pass the
4115 display info directly because we're called from frame.c, which doesn't
4116 know about that structure. */
4119 x_get_focus_frame (frame
)
4120 struct frame
*frame
;
4122 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4124 if (! dpyinfo
->x_focus_frame
)
4127 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4132 /* In certain situations, when the window manager follows a
4133 click-to-focus policy, there seems to be no way around calling
4134 XSetInputFocus to give another frame the input focus .
4136 In an ideal world, XSetInputFocus should generally be avoided so
4137 that applications don't interfere with the window manager's focus
4138 policy. But I think it's okay to use when it's clearly done
4139 following a user-command. */
4141 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4142 "Set the input focus to FRAME.\n\
4143 FRAME nil means use the selected frame.")
4147 struct frame
*f
= check_x_frame (frame
);
4148 Display
*dpy
= FRAME_X_DISPLAY (f
);
4152 count
= x_catch_errors (dpy
);
4153 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4154 RevertToParent
, CurrentTime
);
4155 x_uncatch_errors (dpy
, count
);
4162 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4163 "Internal function called by `color-defined-p', which see.")
4165 Lisp_Object color
, frame
;
4168 FRAME_PTR f
= check_x_frame (frame
);
4170 CHECK_STRING (color
, 1);
4172 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4178 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4179 "Internal function called by `color-values', which see.")
4181 Lisp_Object color
, frame
;
4184 FRAME_PTR f
= check_x_frame (frame
);
4186 CHECK_STRING (color
, 1);
4188 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4192 rgb
[0] = make_number (foo
.red
);
4193 rgb
[1] = make_number (foo
.green
);
4194 rgb
[2] = make_number (foo
.blue
);
4195 return Flist (3, rgb
);
4201 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4202 "Internal function called by `display-color-p', which see.")
4204 Lisp_Object display
;
4206 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4208 if (dpyinfo
->n_planes
<= 2)
4211 switch (dpyinfo
->visual
->class)
4224 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4226 "Return t if the X display supports shades of gray.\n\
4227 Note that color displays do support shades of gray.\n\
4228 The optional argument DISPLAY specifies which display to ask about.\n\
4229 DISPLAY should be either a frame or a display name (a string).\n\
4230 If omitted or nil, that stands for the selected frame's display.")
4232 Lisp_Object display
;
4234 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4236 if (dpyinfo
->n_planes
<= 1)
4239 switch (dpyinfo
->visual
->class)
4254 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4256 "Returns the width in pixels of the X display DISPLAY.\n\
4257 The optional argument DISPLAY specifies which display to ask about.\n\
4258 DISPLAY should be either a frame or a display name (a string).\n\
4259 If omitted or nil, that stands for the selected frame's display.")
4261 Lisp_Object display
;
4263 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4265 return make_number (dpyinfo
->width
);
4268 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4269 Sx_display_pixel_height
, 0, 1, 0,
4270 "Returns the height in pixels of the X display DISPLAY.\n\
4271 The optional argument DISPLAY specifies which display to ask about.\n\
4272 DISPLAY should be either a frame or a display name (a string).\n\
4273 If omitted or nil, that stands for the selected frame's display.")
4275 Lisp_Object display
;
4277 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4279 return make_number (dpyinfo
->height
);
4282 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4284 "Returns the number of bitplanes of the X display DISPLAY.\n\
4285 The optional argument DISPLAY specifies which display to ask about.\n\
4286 DISPLAY should be either a frame or a display name (a string).\n\
4287 If omitted or nil, that stands for the selected frame's display.")
4289 Lisp_Object display
;
4291 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4293 return make_number (dpyinfo
->n_planes
);
4296 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4298 "Returns the number of color cells of the X display DISPLAY.\n\
4299 The optional argument DISPLAY specifies which display to ask about.\n\
4300 DISPLAY should be either a frame or a display name (a string).\n\
4301 If omitted or nil, that stands for the selected frame's display.")
4303 Lisp_Object display
;
4305 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4307 return make_number (DisplayCells (dpyinfo
->display
,
4308 XScreenNumberOfScreen (dpyinfo
->screen
)));
4311 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4312 Sx_server_max_request_size
,
4314 "Returns the maximum request size of the X server of display DISPLAY.\n\
4315 The optional argument DISPLAY specifies which display to ask about.\n\
4316 DISPLAY should be either a frame or a display name (a string).\n\
4317 If omitted or nil, that stands for the selected frame's display.")
4319 Lisp_Object display
;
4321 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4323 return make_number (MAXREQUEST (dpyinfo
->display
));
4326 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4327 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4328 The optional argument DISPLAY specifies which display to ask about.\n\
4329 DISPLAY should be either a frame or a display name (a string).\n\
4330 If omitted or nil, that stands for the selected frame's display.")
4332 Lisp_Object display
;
4334 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4335 char *vendor
= ServerVendor (dpyinfo
->display
);
4337 if (! vendor
) vendor
= "";
4338 return build_string (vendor
);
4341 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4342 "Returns the version numbers of the X server of display DISPLAY.\n\
4343 The value is a list of three integers: the major and minor\n\
4344 version numbers of the X Protocol in use, and the vendor-specific release\n\
4345 number. See also the function `x-server-vendor'.\n\n\
4346 The optional argument DISPLAY specifies which display to ask about.\n\
4347 DISPLAY should be either a frame or a display name (a string).\n\
4348 If omitted or nil, that stands for the selected frame's display.")
4350 Lisp_Object display
;
4352 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4353 Display
*dpy
= dpyinfo
->display
;
4355 return Fcons (make_number (ProtocolVersion (dpy
)),
4356 Fcons (make_number (ProtocolRevision (dpy
)),
4357 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4360 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4361 "Returns the number of screens on the X server of display DISPLAY.\n\
4362 The optional argument DISPLAY specifies which display to ask about.\n\
4363 DISPLAY should be either a frame or a display name (a string).\n\
4364 If omitted or nil, that stands for the selected frame's display.")
4366 Lisp_Object display
;
4368 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4370 return make_number (ScreenCount (dpyinfo
->display
));
4373 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4374 "Returns the height in millimeters of the X display DISPLAY.\n\
4375 The optional argument DISPLAY specifies which display to ask about.\n\
4376 DISPLAY should be either a frame or a display name (a string).\n\
4377 If omitted or nil, that stands for the selected frame's display.")
4379 Lisp_Object display
;
4381 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4383 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4386 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4387 "Returns the width in millimeters of the X display DISPLAY.\n\
4388 The optional argument DISPLAY specifies which display to ask about.\n\
4389 DISPLAY should be either a frame or a display name (a string).\n\
4390 If omitted or nil, that stands for the selected frame's display.")
4392 Lisp_Object display
;
4394 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4396 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4399 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4400 Sx_display_backing_store
, 0, 1, 0,
4401 "Returns an indication of whether X display DISPLAY does backing store.\n\
4402 The value may be `always', `when-mapped', or `not-useful'.\n\
4403 The optional argument DISPLAY specifies which display to ask about.\n\
4404 DISPLAY should be either a frame or a display name (a string).\n\
4405 If omitted or nil, that stands for the selected frame's display.")
4407 Lisp_Object display
;
4409 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4411 switch (DoesBackingStore (dpyinfo
->screen
))
4414 return intern ("always");
4417 return intern ("when-mapped");
4420 return intern ("not-useful");
4423 error ("Strange value for BackingStore parameter of screen");
4427 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4428 Sx_display_visual_class
, 0, 1, 0,
4429 "Returns the visual class of the X display DISPLAY.\n\
4430 The value is one of the symbols `static-gray', `gray-scale',\n\
4431 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4432 The optional argument DISPLAY specifies which display to ask about.\n\
4433 DISPLAY should be either a frame or a display name (a string).\n\
4434 If omitted or nil, that stands for the selected frame's display.")
4436 Lisp_Object display
;
4438 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4440 switch (dpyinfo
->visual
->class)
4442 case StaticGray
: return (intern ("static-gray"));
4443 case GrayScale
: return (intern ("gray-scale"));
4444 case StaticColor
: return (intern ("static-color"));
4445 case PseudoColor
: return (intern ("pseudo-color"));
4446 case TrueColor
: return (intern ("true-color"));
4447 case DirectColor
: return (intern ("direct-color"));
4449 error ("Display has an unknown visual class");
4453 DEFUN ("x-display-save-under", Fx_display_save_under
,
4454 Sx_display_save_under
, 0, 1, 0,
4455 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4456 The optional argument DISPLAY specifies which display to ask about.\n\
4457 DISPLAY should be either a frame or a display name (a string).\n\
4458 If omitted or nil, that stands for the selected frame's display.")
4460 Lisp_Object display
;
4462 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4464 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4472 register struct frame
*f
;
4474 return PIXEL_WIDTH (f
);
4479 register struct frame
*f
;
4481 return PIXEL_HEIGHT (f
);
4486 register struct frame
*f
;
4488 return FONT_WIDTH (f
->output_data
.x
->font
);
4493 register struct frame
*f
;
4495 return f
->output_data
.x
->line_height
;
4500 register struct frame
*f
;
4502 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4507 /************************************************************************
4509 ************************************************************************/
4512 /* Mapping visual names to visuals. */
4514 static struct visual_class
4521 {"StaticGray", StaticGray
},
4522 {"GrayScale", GrayScale
},
4523 {"StaticColor", StaticColor
},
4524 {"PseudoColor", PseudoColor
},
4525 {"TrueColor", TrueColor
},
4526 {"DirectColor", DirectColor
},
4531 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4533 /* Value is the screen number of screen SCR. This is a substitute for
4534 the X function with the same name when that doesn't exist. */
4537 XScreenNumberOfScreen (scr
)
4538 register Screen
*scr
;
4540 Display
*dpy
= scr
->display
;
4543 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4544 if (scr
== dpy
->screens
[i
])
4550 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4553 /* Select the visual that should be used on display DPYINFO. Set
4554 members of DPYINFO appropriately. Called from x_term_init. */
4557 select_visual (dpyinfo
)
4558 struct x_display_info
*dpyinfo
;
4560 Display
*dpy
= dpyinfo
->display
;
4561 Screen
*screen
= dpyinfo
->screen
;
4564 /* See if a visual is specified. */
4565 value
= display_x_get_resource (dpyinfo
,
4566 build_string ("visualClass"),
4567 build_string ("VisualClass"),
4569 if (STRINGP (value
))
4571 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4572 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4573 depth, a decimal number. NAME is compared with case ignored. */
4574 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4579 strcpy (s
, XSTRING (value
)->data
);
4580 dash
= index (s
, '-');
4583 dpyinfo
->n_planes
= atoi (dash
+ 1);
4587 /* We won't find a matching visual with depth 0, so that
4588 an error will be printed below. */
4589 dpyinfo
->n_planes
= 0;
4591 /* Determine the visual class. */
4592 for (i
= 0; visual_classes
[i
].name
; ++i
)
4593 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4595 class = visual_classes
[i
].class;
4599 /* Look up a matching visual for the specified class. */
4601 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4602 dpyinfo
->n_planes
, class, &vinfo
))
4603 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4605 dpyinfo
->visual
= vinfo
.visual
;
4610 XVisualInfo
*vinfo
, vinfo_template
;
4612 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4615 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4617 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4619 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4620 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4621 &vinfo_template
, &n_visuals
);
4623 fatal ("Can't get proper X visual info");
4625 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
4626 dpyinfo
->n_planes
= vinfo
->depth
;
4630 int n
= vinfo
->colormap_size
- 1;
4636 dpyinfo
->n_planes
= i
;
4639 XFree ((char *) vinfo
);
4644 /* Return the X display structure for the display named NAME.
4645 Open a new connection if necessary. */
4647 struct x_display_info
*
4648 x_display_info_for_name (name
)
4652 struct x_display_info
*dpyinfo
;
4654 CHECK_STRING (name
, 0);
4656 if (! EQ (Vwindow_system
, intern ("x")))
4657 error ("Not using X Windows");
4659 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4661 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4664 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4669 /* Use this general default value to start with. */
4670 Vx_resource_name
= Vinvocation_name
;
4672 validate_x_resource_name ();
4674 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4675 (char *) XSTRING (Vx_resource_name
)->data
);
4678 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4681 XSETFASTINT (Vwindow_system_version
, 11);
4687 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4688 1, 3, 0, "Open a connection to an X server.\n\
4689 DISPLAY is the name of the display to connect to.\n\
4690 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4691 If the optional third arg MUST-SUCCEED is non-nil,\n\
4692 terminate Emacs if we can't open the connection.")
4693 (display
, xrm_string
, must_succeed
)
4694 Lisp_Object display
, xrm_string
, must_succeed
;
4696 unsigned char *xrm_option
;
4697 struct x_display_info
*dpyinfo
;
4699 CHECK_STRING (display
, 0);
4700 if (! NILP (xrm_string
))
4701 CHECK_STRING (xrm_string
, 1);
4703 if (! EQ (Vwindow_system
, intern ("x")))
4704 error ("Not using X Windows");
4706 if (! NILP (xrm_string
))
4707 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4709 xrm_option
= (unsigned char *) 0;
4711 validate_x_resource_name ();
4713 /* This is what opens the connection and sets x_current_display.
4714 This also initializes many symbols, such as those used for input. */
4715 dpyinfo
= x_term_init (display
, xrm_option
,
4716 (char *) XSTRING (Vx_resource_name
)->data
);
4720 if (!NILP (must_succeed
))
4721 fatal ("Cannot connect to X server %s.\n\
4722 Check the DISPLAY environment variable or use `-d'.\n\
4723 Also use the `xhost' program to verify that it is set to permit\n\
4724 connections from your machine.\n",
4725 XSTRING (display
)->data
);
4727 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4732 XSETFASTINT (Vwindow_system_version
, 11);
4736 DEFUN ("x-close-connection", Fx_close_connection
,
4737 Sx_close_connection
, 1, 1, 0,
4738 "Close the connection to DISPLAY's X server.\n\
4739 For DISPLAY, specify either a frame or a display name (a string).\n\
4740 If DISPLAY is nil, that stands for the selected frame's display.")
4742 Lisp_Object display
;
4744 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4747 if (dpyinfo
->reference_count
> 0)
4748 error ("Display still has frames on it");
4751 /* Free the fonts in the font table. */
4752 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4753 if (dpyinfo
->font_table
[i
].name
)
4755 xfree (dpyinfo
->font_table
[i
].name
);
4756 /* Don't free the full_name string;
4757 it is always shared with something else. */
4758 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4761 x_destroy_all_bitmaps (dpyinfo
);
4762 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4764 #ifdef USE_X_TOOLKIT
4765 XtCloseDisplay (dpyinfo
->display
);
4767 XCloseDisplay (dpyinfo
->display
);
4770 x_delete_display (dpyinfo
);
4776 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4777 "Return the list of display names that Emacs has connections to.")
4780 Lisp_Object tail
, result
;
4783 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4784 result
= Fcons (XCAR (XCAR (tail
)), result
);
4789 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4790 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4791 If ON is nil, allow buffering of requests.\n\
4792 Turning on synchronization prohibits the Xlib routines from buffering\n\
4793 requests and seriously degrades performance, but makes debugging much\n\
4795 The optional second argument DISPLAY specifies which display to act on.\n\
4796 DISPLAY should be either a frame or a display name (a string).\n\
4797 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4799 Lisp_Object display
, on
;
4801 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4803 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4808 /* Wait for responses to all X commands issued so far for frame F. */
4815 XSync (FRAME_X_DISPLAY (f
), False
);
4820 /***********************************************************************
4822 ***********************************************************************/
4824 /* Value is the number of elements of vector VECTOR. */
4826 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4828 /* List of supported image types. Use define_image_type to add new
4829 types. Use lookup_image_type to find a type for a given symbol. */
4831 static struct image_type
*image_types
;
4833 /* A list of symbols, one for each supported image type. */
4835 Lisp_Object Vimage_types
;
4837 /* The symbol `image' which is the car of the lists used to represent
4840 extern Lisp_Object Qimage
;
4842 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4848 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
4849 extern Lisp_Object QCdata
;
4850 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
4851 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
4852 Lisp_Object QCindex
;
4854 /* Other symbols. */
4856 Lisp_Object Qlaplace
;
4858 /* Time in seconds after which images should be removed from the cache
4859 if not displayed. */
4861 Lisp_Object Vimage_cache_eviction_delay
;
4863 /* Function prototypes. */
4865 static void define_image_type
P_ ((struct image_type
*type
));
4866 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
4867 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
4868 static void x_laplace
P_ ((struct frame
*, struct image
*));
4869 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
4873 /* Define a new image type from TYPE. This adds a copy of TYPE to
4874 image_types and adds the symbol *TYPE->type to Vimage_types. */
4877 define_image_type (type
)
4878 struct image_type
*type
;
4880 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4881 The initialized data segment is read-only. */
4882 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
4883 bcopy (type
, p
, sizeof *p
);
4884 p
->next
= image_types
;
4886 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
4890 /* Look up image type SYMBOL, and return a pointer to its image_type
4891 structure. Value is null if SYMBOL is not a known image type. */
4893 static INLINE
struct image_type
*
4894 lookup_image_type (symbol
)
4897 struct image_type
*type
;
4899 for (type
= image_types
; type
; type
= type
->next
)
4900 if (EQ (symbol
, *type
->type
))
4907 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4908 valid image specification is a list whose car is the symbol
4909 `image', and whose rest is a property list. The property list must
4910 contain a value for key `:type'. That value must be the name of a
4911 supported image type. The rest of the property list depends on the
4915 valid_image_p (object
)
4920 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
4922 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
4923 struct image_type
*type
= lookup_image_type (symbol
);
4926 valid_p
= type
->valid_p (object
);
4933 /* Log error message with format string FORMAT and argument ARG.
4934 Signaling an error, e.g. when an image cannot be loaded, is not a
4935 good idea because this would interrupt redisplay, and the error
4936 message display would lead to another redisplay. This function
4937 therefore simply displays a message. */
4940 image_error (format
, arg1
, arg2
)
4942 Lisp_Object arg1
, arg2
;
4944 add_to_log (format
, arg1
, arg2
);
4949 /***********************************************************************
4950 Image specifications
4951 ***********************************************************************/
4953 enum image_value_type
4955 IMAGE_DONT_CHECK_VALUE_TYPE
,
4958 IMAGE_POSITIVE_INTEGER_VALUE
,
4959 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
4960 IMAGE_INTEGER_VALUE
,
4961 IMAGE_FUNCTION_VALUE
,
4966 /* Structure used when parsing image specifications. */
4968 struct image_keyword
4970 /* Name of keyword. */
4973 /* The type of value allowed. */
4974 enum image_value_type type
;
4976 /* Non-zero means key must be present. */
4979 /* Used to recognize duplicate keywords in a property list. */
4982 /* The value that was found. */
4987 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
4989 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
4992 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
4993 has the format (image KEYWORD VALUE ...). One of the keyword/
4994 value pairs must be `:type TYPE'. KEYWORDS is a vector of
4995 image_keywords structures of size NKEYWORDS describing other
4996 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
4999 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5001 struct image_keyword
*keywords
;
5008 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5011 plist
= XCDR (spec
);
5012 while (CONSP (plist
))
5014 Lisp_Object key
, value
;
5016 /* First element of a pair must be a symbol. */
5018 plist
= XCDR (plist
);
5022 /* There must follow a value. */
5025 value
= XCAR (plist
);
5026 plist
= XCDR (plist
);
5028 /* Find key in KEYWORDS. Error if not found. */
5029 for (i
= 0; i
< nkeywords
; ++i
)
5030 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5036 /* Record that we recognized the keyword. If a keywords
5037 was found more than once, it's an error. */
5038 keywords
[i
].value
= value
;
5039 ++keywords
[i
].count
;
5041 if (keywords
[i
].count
> 1)
5044 /* Check type of value against allowed type. */
5045 switch (keywords
[i
].type
)
5047 case IMAGE_STRING_VALUE
:
5048 if (!STRINGP (value
))
5052 case IMAGE_SYMBOL_VALUE
:
5053 if (!SYMBOLP (value
))
5057 case IMAGE_POSITIVE_INTEGER_VALUE
:
5058 if (!INTEGERP (value
) || XINT (value
) <= 0)
5062 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5063 if (!INTEGERP (value
) || XINT (value
) < 0)
5067 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5070 case IMAGE_FUNCTION_VALUE
:
5071 value
= indirect_function (value
);
5073 || COMPILEDP (value
)
5074 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5078 case IMAGE_NUMBER_VALUE
:
5079 if (!INTEGERP (value
) && !FLOATP (value
))
5083 case IMAGE_INTEGER_VALUE
:
5084 if (!INTEGERP (value
))
5088 case IMAGE_BOOL_VALUE
:
5089 if (!NILP (value
) && !EQ (value
, Qt
))
5098 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5102 /* Check that all mandatory fields are present. */
5103 for (i
= 0; i
< nkeywords
; ++i
)
5104 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5107 return NILP (plist
);
5111 /* Return the value of KEY in image specification SPEC. Value is nil
5112 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5113 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5116 image_spec_value (spec
, key
, found
)
5117 Lisp_Object spec
, key
;
5122 xassert (valid_image_p (spec
));
5124 for (tail
= XCDR (spec
);
5125 CONSP (tail
) && CONSP (XCDR (tail
));
5126 tail
= XCDR (XCDR (tail
)))
5128 if (EQ (XCAR (tail
), key
))
5132 return XCAR (XCDR (tail
));
5144 /***********************************************************************
5145 Image type independent image structures
5146 ***********************************************************************/
5148 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5149 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5152 /* Allocate and return a new image structure for image specification
5153 SPEC. SPEC has a hash value of HASH. */
5155 static struct image
*
5156 make_image (spec
, hash
)
5160 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5162 xassert (valid_image_p (spec
));
5163 bzero (img
, sizeof *img
);
5164 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5165 xassert (img
->type
!= NULL
);
5167 img
->data
.lisp_val
= Qnil
;
5168 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5174 /* Free image IMG which was used on frame F, including its resources. */
5183 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5185 /* Remove IMG from the hash table of its cache. */
5187 img
->prev
->next
= img
->next
;
5189 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5192 img
->next
->prev
= img
->prev
;
5194 c
->images
[img
->id
] = NULL
;
5196 /* Free resources, then free IMG. */
5197 img
->type
->free (f
, img
);
5203 /* Prepare image IMG for display on frame F. Must be called before
5204 drawing an image. */
5207 prepare_image_for_display (f
, img
)
5213 /* We're about to display IMG, so set its timestamp to `now'. */
5215 img
->timestamp
= EMACS_SECS (t
);
5217 /* If IMG doesn't have a pixmap yet, load it now, using the image
5218 type dependent loader function. */
5219 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5220 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5225 /***********************************************************************
5226 Helper functions for X image types
5227 ***********************************************************************/
5229 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5230 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5232 Lisp_Object color_name
,
5233 unsigned long dflt
));
5235 /* Free X resources of image IMG which is used on frame F. */
5238 x_clear_image (f
, img
)
5245 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5253 x_free_colors (f
, img
->colors
, img
->ncolors
);
5256 xfree (img
->colors
);
5263 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5264 cannot be allocated, use DFLT. Add a newly allocated color to
5265 IMG->colors, so that it can be freed again. Value is the pixel
5268 static unsigned long
5269 x_alloc_image_color (f
, img
, color_name
, dflt
)
5272 Lisp_Object color_name
;
5276 unsigned long result
;
5278 xassert (STRINGP (color_name
));
5280 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5282 /* This isn't called frequently so we get away with simply
5283 reallocating the color vector to the needed size, here. */
5286 (unsigned long *) xrealloc (img
->colors
,
5287 img
->ncolors
* sizeof *img
->colors
);
5288 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5289 result
= color
.pixel
;
5299 /***********************************************************************
5301 ***********************************************************************/
5303 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5306 /* Return a new, initialized image cache that is allocated from the
5307 heap. Call free_image_cache to free an image cache. */
5309 struct image_cache
*
5312 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5315 bzero (c
, sizeof *c
);
5317 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5318 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5319 c
->buckets
= (struct image
**) xmalloc (size
);
5320 bzero (c
->buckets
, size
);
5325 /* Free image cache of frame F. Be aware that X frames share images
5329 free_image_cache (f
)
5332 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5337 /* Cache should not be referenced by any frame when freed. */
5338 xassert (c
->refcount
== 0);
5340 for (i
= 0; i
< c
->used
; ++i
)
5341 free_image (f
, c
->images
[i
]);
5345 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5350 /* Clear image cache of frame F. FORCE_P non-zero means free all
5351 images. FORCE_P zero means clear only images that haven't been
5352 displayed for some time. Should be called from time to time to
5353 reduce the number of loaded images. If image-eviction-seconds is
5354 non-nil, this frees images in the cache which weren't displayed for
5355 at least that many seconds. */
5358 clear_image_cache (f
, force_p
)
5362 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5364 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5368 int i
, any_freed_p
= 0;
5371 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5373 for (i
= 0; i
< c
->used
; ++i
)
5375 struct image
*img
= c
->images
[i
];
5378 || (img
->timestamp
> old
)))
5380 free_image (f
, img
);
5385 /* We may be clearing the image cache because, for example,
5386 Emacs was iconified for a longer period of time. In that
5387 case, current matrices may still contain references to
5388 images freed above. So, clear these matrices. */
5391 clear_current_matrices (f
);
5392 ++windows_or_buffers_changed
;
5398 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5400 "Clear the image cache of FRAME.\n\
5401 FRAME nil or omitted means use the selected frame.\n\
5402 FRAME t means clear the image caches of all frames.")
5410 FOR_EACH_FRAME (tail
, frame
)
5411 if (FRAME_X_P (XFRAME (frame
)))
5412 clear_image_cache (XFRAME (frame
), 1);
5415 clear_image_cache (check_x_frame (frame
), 1);
5421 /* Return the id of image with Lisp specification SPEC on frame F.
5422 SPEC must be a valid Lisp image specification (see valid_image_p). */
5425 lookup_image (f
, spec
)
5429 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5433 struct gcpro gcpro1
;
5436 /* F must be a window-system frame, and SPEC must be a valid image
5438 xassert (FRAME_WINDOW_P (f
));
5439 xassert (valid_image_p (spec
));
5443 /* Look up SPEC in the hash table of the image cache. */
5444 hash
= sxhash (spec
, 0);
5445 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5447 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5448 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5451 /* If not found, create a new image and cache it. */
5454 img
= make_image (spec
, hash
);
5455 cache_image (f
, img
);
5456 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5457 xassert (!interrupt_input_blocked
);
5459 /* If we can't load the image, and we don't have a width and
5460 height, use some arbitrary width and height so that we can
5461 draw a rectangle for it. */
5462 if (img
->load_failed_p
)
5466 value
= image_spec_value (spec
, QCwidth
, NULL
);
5467 img
->width
= (INTEGERP (value
)
5468 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5469 value
= image_spec_value (spec
, QCheight
, NULL
);
5470 img
->height
= (INTEGERP (value
)
5471 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5475 /* Handle image type independent image attributes
5476 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
5477 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
5480 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5481 if (INTEGERP (ascent
))
5482 img
->ascent
= XFASTINT (ascent
);
5484 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5485 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5486 img
->margin
= XFASTINT (margin
);
5488 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5489 if (INTEGERP (relief
))
5491 img
->relief
= XINT (relief
);
5492 img
->margin
+= abs (img
->relief
);
5495 /* Should we apply a Laplace edge-detection algorithm? */
5496 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5497 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
5500 /* Should we built a mask heuristically? */
5501 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5502 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
5503 x_build_heuristic_mask (f
, img
, heuristic_mask
);
5507 /* We're using IMG, so set its timestamp to `now'. */
5508 EMACS_GET_TIME (now
);
5509 img
->timestamp
= EMACS_SECS (now
);
5513 /* Value is the image id. */
5518 /* Cache image IMG in the image cache of frame F. */
5521 cache_image (f
, img
)
5525 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5528 /* Find a free slot in c->images. */
5529 for (i
= 0; i
< c
->used
; ++i
)
5530 if (c
->images
[i
] == NULL
)
5533 /* If no free slot found, maybe enlarge c->images. */
5534 if (i
== c
->used
&& c
->used
== c
->size
)
5537 c
->images
= (struct image
**) xrealloc (c
->images
,
5538 c
->size
* sizeof *c
->images
);
5541 /* Add IMG to c->images, and assign IMG an id. */
5547 /* Add IMG to the cache's hash table. */
5548 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5549 img
->next
= c
->buckets
[i
];
5551 img
->next
->prev
= img
;
5553 c
->buckets
[i
] = img
;
5557 /* Call FN on every image in the image cache of frame F. Used to mark
5558 Lisp Objects in the image cache. */
5561 forall_images_in_image_cache (f
, fn
)
5563 void (*fn
) P_ ((struct image
*img
));
5565 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5567 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5571 for (i
= 0; i
< c
->used
; ++i
)
5580 /***********************************************************************
5582 ***********************************************************************/
5584 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5585 XImage
**, Pixmap
*));
5586 static void x_destroy_x_image
P_ ((XImage
*));
5587 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5590 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5591 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5592 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5593 via xmalloc. Print error messages via image_error if an error
5594 occurs. Value is non-zero if successful. */
5597 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5599 int width
, height
, depth
;
5603 Display
*display
= FRAME_X_DISPLAY (f
);
5604 Screen
*screen
= FRAME_X_SCREEN (f
);
5605 Window window
= FRAME_X_WINDOW (f
);
5607 xassert (interrupt_input_blocked
);
5610 depth
= DefaultDepthOfScreen (screen
);
5611 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5612 depth
, ZPixmap
, 0, NULL
, width
, height
,
5613 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5616 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5620 /* Allocate image raster. */
5621 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5623 /* Allocate a pixmap of the same size. */
5624 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5627 x_destroy_x_image (*ximg
);
5629 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
5637 /* Destroy XImage XIMG. Free XIMG->data. */
5640 x_destroy_x_image (ximg
)
5643 xassert (interrupt_input_blocked
);
5648 XDestroyImage (ximg
);
5653 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5654 are width and height of both the image and pixmap. */
5657 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
5664 xassert (interrupt_input_blocked
);
5665 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
5666 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
5667 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
5672 /***********************************************************************
5674 ***********************************************************************/
5676 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
5678 /* Find image file FILE. Look in data-directory, then
5679 x-bitmap-file-path. Value is the full name of the file found, or
5680 nil if not found. */
5683 x_find_image_file (file
)
5686 Lisp_Object file_found
, search_path
;
5687 struct gcpro gcpro1
, gcpro2
;
5691 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
5692 GCPRO2 (file_found
, search_path
);
5694 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5695 fd
= openp (search_path
, file
, "", &file_found
, 0);
5708 /***********************************************************************
5710 ***********************************************************************/
5712 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
5713 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
5715 static int xbm_image_p
P_ ((Lisp_Object object
));
5716 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
5720 /* Indices of image specification fields in xbm_format, below. */
5722 enum xbm_keyword_index
5739 /* Vector of image_keyword structures describing the format
5740 of valid XBM image specifications. */
5742 static struct image_keyword xbm_format
[XBM_LAST
] =
5744 {":type", IMAGE_SYMBOL_VALUE
, 1},
5745 {":file", IMAGE_STRING_VALUE
, 0},
5746 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5747 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5748 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5749 {":foreground", IMAGE_STRING_VALUE
, 0},
5750 {":background", IMAGE_STRING_VALUE
, 0},
5751 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
5752 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5753 {":relief", IMAGE_INTEGER_VALUE
, 0},
5754 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5755 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
5758 /* Structure describing the image type XBM. */
5760 static struct image_type xbm_type
=
5769 /* Tokens returned from xbm_scan. */
5778 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5779 A valid specification is a list starting with the symbol `image'
5780 The rest of the list is a property list which must contain an
5783 If the specification specifies a file to load, it must contain
5784 an entry `:file FILENAME' where FILENAME is a string.
5786 If the specification is for a bitmap loaded from memory it must
5787 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5788 WIDTH and HEIGHT are integers > 0. DATA may be:
5790 1. a string large enough to hold the bitmap data, i.e. it must
5791 have a size >= (WIDTH + 7) / 8 * HEIGHT
5793 2. a bool-vector of size >= WIDTH * HEIGHT
5795 3. a vector of strings or bool-vectors, one for each line of the
5798 Both the file and data forms may contain the additional entries
5799 `:background COLOR' and `:foreground COLOR'. If not present,
5800 foreground and background of the frame on which the image is
5801 displayed, is used. */
5804 xbm_image_p (object
)
5807 struct image_keyword kw
[XBM_LAST
];
5809 bcopy (xbm_format
, kw
, sizeof kw
);
5810 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
5813 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
5815 if (kw
[XBM_FILE
].count
)
5817 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
5825 /* Entries for `:width', `:height' and `:data' must be present. */
5826 if (!kw
[XBM_WIDTH
].count
5827 || !kw
[XBM_HEIGHT
].count
5828 || !kw
[XBM_DATA
].count
)
5831 data
= kw
[XBM_DATA
].value
;
5832 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
5833 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
5835 /* Check type of data, and width and height against contents of
5841 /* Number of elements of the vector must be >= height. */
5842 if (XVECTOR (data
)->size
< height
)
5845 /* Each string or bool-vector in data must be large enough
5846 for one line of the image. */
5847 for (i
= 0; i
< height
; ++i
)
5849 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
5853 if (XSTRING (elt
)->size
5854 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
5857 else if (BOOL_VECTOR_P (elt
))
5859 if (XBOOL_VECTOR (elt
)->size
< width
)
5866 else if (STRINGP (data
))
5868 if (XSTRING (data
)->size
5869 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
5872 else if (BOOL_VECTOR_P (data
))
5874 if (XBOOL_VECTOR (data
)->size
< width
* height
)
5881 /* Baseline must be a value between 0 and 100 (a percentage). */
5882 if (kw
[XBM_ASCENT
].count
5883 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
5890 /* Scan a bitmap file. FP is the stream to read from. Value is
5891 either an enumerator from enum xbm_token, or a character for a
5892 single-character token, or 0 at end of file. If scanning an
5893 identifier, store the lexeme of the identifier in SVAL. If
5894 scanning a number, store its value in *IVAL. */
5897 xbm_scan (fp
, sval
, ival
)
5904 /* Skip white space. */
5905 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
5910 else if (isdigit (c
))
5912 int value
= 0, digit
;
5917 if (c
== 'x' || c
== 'X')
5919 while ((c
= fgetc (fp
)) != EOF
)
5923 else if (c
>= 'a' && c
<= 'f')
5924 digit
= c
- 'a' + 10;
5925 else if (c
>= 'A' && c
<= 'F')
5926 digit
= c
- 'A' + 10;
5929 value
= 16 * value
+ digit
;
5932 else if (isdigit (c
))
5935 while ((c
= fgetc (fp
)) != EOF
5937 value
= 8 * value
+ c
- '0';
5943 while ((c
= fgetc (fp
)) != EOF
5945 value
= 10 * value
+ c
- '0';
5953 else if (isalpha (c
) || c
== '_')
5956 while ((c
= fgetc (fp
)) != EOF
5957 && (isalnum (c
) || c
== '_'))
5969 /* Replacement for XReadBitmapFileData which isn't available under old
5970 X versions. FILE is the name of the bitmap file to read. Set
5971 *WIDTH and *HEIGHT to the width and height of the image. Return in
5972 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
5976 xbm_read_bitmap_file_data (file
, width
, height
, data
)
5978 int *width
, *height
;
5979 unsigned char **data
;
5982 char buffer
[BUFSIZ
];
5985 int bytes_per_line
, i
, nbytes
;
5991 LA1 = xbm_scan (fp, buffer, &value)
5993 #define expect(TOKEN) \
5994 if (LA1 != (TOKEN)) \
5999 #define expect_ident(IDENT) \
6000 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6005 fp
= fopen (file
, "r");
6009 *width
= *height
= -1;
6011 LA1
= xbm_scan (fp
, buffer
, &value
);
6013 /* Parse defines for width, height and hot-spots. */
6017 expect_ident ("define");
6018 expect (XBM_TK_IDENT
);
6020 if (LA1
== XBM_TK_NUMBER
);
6022 char *p
= strrchr (buffer
, '_');
6023 p
= p
? p
+ 1 : buffer
;
6024 if (strcmp (p
, "width") == 0)
6026 else if (strcmp (p
, "height") == 0)
6029 expect (XBM_TK_NUMBER
);
6032 if (*width
< 0 || *height
< 0)
6035 /* Parse bits. Must start with `static'. */
6036 expect_ident ("static");
6037 if (LA1
== XBM_TK_IDENT
)
6039 if (strcmp (buffer
, "unsigned") == 0)
6042 expect_ident ("char");
6044 else if (strcmp (buffer
, "short") == 0)
6048 if (*width
% 16 && *width
% 16 < 9)
6051 else if (strcmp (buffer
, "char") == 0)
6059 expect (XBM_TK_IDENT
);
6065 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6066 nbytes
= bytes_per_line
* *height
;
6067 p
= *data
= (char *) xmalloc (nbytes
);
6072 for (i
= 0; i
< nbytes
; i
+= 2)
6075 expect (XBM_TK_NUMBER
);
6078 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6081 if (LA1
== ',' || LA1
== '}')
6089 for (i
= 0; i
< nbytes
; ++i
)
6092 expect (XBM_TK_NUMBER
);
6096 if (LA1
== ',' || LA1
== '}')
6122 /* Load XBM image IMG which will be displayed on frame F from file
6123 SPECIFIED_FILE. Value is non-zero if successful. */
6126 xbm_load_image_from_file (f
, img
, specified_file
)
6129 Lisp_Object specified_file
;
6132 unsigned char *data
;
6135 struct gcpro gcpro1
;
6137 xassert (STRINGP (specified_file
));
6141 file
= x_find_image_file (specified_file
);
6142 if (!STRINGP (file
))
6144 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6149 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6150 &img
->height
, &data
);
6153 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6154 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6155 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6158 xassert (img
->width
> 0 && img
->height
> 0);
6160 /* Get foreground and background colors, maybe allocate colors. */
6161 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6163 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6165 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6167 background
= x_alloc_image_color (f
, img
, value
, background
);
6171 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6174 img
->width
, img
->height
,
6175 foreground
, background
,
6179 if (img
->pixmap
== 0)
6181 x_clear_image (f
, img
);
6182 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6190 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6197 /* Fill image IMG which is used on frame F with pixmap data. Value is
6198 non-zero if successful. */
6206 Lisp_Object file_name
;
6208 xassert (xbm_image_p (img
->spec
));
6210 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6211 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6212 if (STRINGP (file_name
))
6213 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6216 struct image_keyword fmt
[XBM_LAST
];
6219 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6220 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6224 /* Parse the list specification. */
6225 bcopy (xbm_format
, fmt
, sizeof fmt
);
6226 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6229 /* Get specified width, and height. */
6230 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6231 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6232 xassert (img
->width
> 0 && img
->height
> 0);
6236 if (fmt
[XBM_ASCENT
].count
)
6237 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6239 /* Get foreground and background colors, maybe allocate colors. */
6240 if (fmt
[XBM_FOREGROUND
].count
)
6241 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6243 if (fmt
[XBM_BACKGROUND
].count
)
6244 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6247 /* Set bits to the bitmap image data. */
6248 data
= fmt
[XBM_DATA
].value
;
6253 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6255 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6256 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6258 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6260 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6262 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6265 else if (STRINGP (data
))
6266 bits
= XSTRING (data
)->data
;
6268 bits
= XBOOL_VECTOR (data
)->data
;
6270 /* Create the pixmap. */
6271 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6273 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6276 img
->width
, img
->height
,
6277 foreground
, background
,
6283 image_error ("Unable to create pixmap for XBM image `%s'",
6285 x_clear_image (f
, img
);
6296 /***********************************************************************
6298 ***********************************************************************/
6302 static int xpm_image_p
P_ ((Lisp_Object object
));
6303 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6304 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6306 #include "X11/xpm.h"
6308 /* The symbol `xpm' identifying XPM-format images. */
6312 /* Indices of image specification fields in xpm_format, below. */
6314 enum xpm_keyword_index
6328 /* Vector of image_keyword structures describing the format
6329 of valid XPM image specifications. */
6331 static struct image_keyword xpm_format
[XPM_LAST
] =
6333 {":type", IMAGE_SYMBOL_VALUE
, 1},
6334 {":file", IMAGE_STRING_VALUE
, 0},
6335 {":data", IMAGE_STRING_VALUE
, 0},
6336 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6337 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6338 {":relief", IMAGE_INTEGER_VALUE
, 0},
6339 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6340 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6341 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6344 /* Structure describing the image type XBM. */
6346 static struct image_type xpm_type
=
6356 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6357 for XPM images. Such a list must consist of conses whose car and
6361 xpm_valid_color_symbols_p (color_symbols
)
6362 Lisp_Object color_symbols
;
6364 while (CONSP (color_symbols
))
6366 Lisp_Object sym
= XCAR (color_symbols
);
6368 || !STRINGP (XCAR (sym
))
6369 || !STRINGP (XCDR (sym
)))
6371 color_symbols
= XCDR (color_symbols
);
6374 return NILP (color_symbols
);
6378 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6381 xpm_image_p (object
)
6384 struct image_keyword fmt
[XPM_LAST
];
6385 bcopy (xpm_format
, fmt
, sizeof fmt
);
6386 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6387 /* Either `:file' or `:data' must be present. */
6388 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6389 /* Either no `:color-symbols' or it's a list of conses
6390 whose car and cdr are strings. */
6391 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6392 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6393 && (fmt
[XPM_ASCENT
].count
== 0
6394 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6398 /* Load image IMG which will be displayed on frame F. Value is
6399 non-zero if successful. */
6407 XpmAttributes attrs
;
6408 Lisp_Object specified_file
, color_symbols
;
6410 /* Configure the XPM lib. Use the visual of frame F. Allocate
6411 close colors. Return colors allocated. */
6412 bzero (&attrs
, sizeof attrs
);
6413 attrs
.visual
= FRAME_X_VISUAL (f
);
6414 attrs
.colormap
= FRAME_X_COLORMAP (f
);
6415 attrs
.valuemask
|= XpmVisual
;
6416 attrs
.valuemask
|= XpmColormap
;
6417 attrs
.valuemask
|= XpmReturnAllocPixels
;
6418 #ifdef XpmAllocCloseColors
6419 attrs
.alloc_close_colors
= 1;
6420 attrs
.valuemask
|= XpmAllocCloseColors
;
6422 attrs
.closeness
= 600;
6423 attrs
.valuemask
|= XpmCloseness
;
6426 /* If image specification contains symbolic color definitions, add
6427 these to `attrs'. */
6428 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
6429 if (CONSP (color_symbols
))
6432 XpmColorSymbol
*xpm_syms
;
6435 attrs
.valuemask
|= XpmColorSymbols
;
6437 /* Count number of symbols. */
6438 attrs
.numsymbols
= 0;
6439 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
6442 /* Allocate an XpmColorSymbol array. */
6443 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
6444 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
6445 bzero (xpm_syms
, size
);
6446 attrs
.colorsymbols
= xpm_syms
;
6448 /* Fill the color symbol array. */
6449 for (tail
= color_symbols
, i
= 0;
6451 ++i
, tail
= XCDR (tail
))
6453 Lisp_Object name
= XCAR (XCAR (tail
));
6454 Lisp_Object color
= XCDR (XCAR (tail
));
6455 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
6456 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
6457 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
6458 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
6462 /* Create a pixmap for the image, either from a file, or from a
6463 string buffer containing data in the same format as an XPM file. */
6465 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6466 if (STRINGP (specified_file
))
6468 Lisp_Object file
= x_find_image_file (specified_file
);
6469 if (!STRINGP (file
))
6471 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6476 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6477 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
6482 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
6483 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6484 XSTRING (buffer
)->data
,
6485 &img
->pixmap
, &img
->mask
,
6490 if (rc
== XpmSuccess
)
6492 /* Remember allocated colors. */
6493 img
->ncolors
= attrs
.nalloc_pixels
;
6494 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
6495 * sizeof *img
->colors
);
6496 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
6497 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
6499 img
->width
= attrs
.width
;
6500 img
->height
= attrs
.height
;
6501 xassert (img
->width
> 0 && img
->height
> 0);
6503 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6505 XpmFreeAttributes (&attrs
);
6513 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
6516 case XpmFileInvalid
:
6517 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
6521 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
6524 case XpmColorFailed
:
6525 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
6529 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
6534 return rc
== XpmSuccess
;
6537 #endif /* HAVE_XPM != 0 */
6540 /***********************************************************************
6542 ***********************************************************************/
6544 /* An entry in the color table mapping an RGB color to a pixel color. */
6549 unsigned long pixel
;
6551 /* Next in color table collision list. */
6552 struct ct_color
*next
;
6555 /* The bucket vector size to use. Must be prime. */
6559 /* Value is a hash of the RGB color given by R, G, and B. */
6561 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6563 /* The color hash table. */
6565 struct ct_color
**ct_table
;
6567 /* Number of entries in the color table. */
6569 int ct_colors_allocated
;
6571 /* Function prototypes. */
6573 static void init_color_table
P_ ((void));
6574 static void free_color_table
P_ ((void));
6575 static unsigned long *colors_in_color_table
P_ ((int *n
));
6576 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
6577 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
6580 /* Initialize the color table. */
6585 int size
= CT_SIZE
* sizeof (*ct_table
);
6586 ct_table
= (struct ct_color
**) xmalloc (size
);
6587 bzero (ct_table
, size
);
6588 ct_colors_allocated
= 0;
6592 /* Free memory associated with the color table. */
6598 struct ct_color
*p
, *next
;
6600 for (i
= 0; i
< CT_SIZE
; ++i
)
6601 for (p
= ct_table
[i
]; p
; p
= next
)
6612 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6613 entry for that color already is in the color table, return the
6614 pixel color of that entry. Otherwise, allocate a new color for R,
6615 G, B, and make an entry in the color table. */
6617 static unsigned long
6618 lookup_rgb_color (f
, r
, g
, b
)
6622 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
6623 int i
= hash
% CT_SIZE
;
6626 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6627 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
6641 cmap
= FRAME_X_COLORMAP (f
);
6642 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6647 ++ct_colors_allocated
;
6649 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6653 p
->pixel
= color
.pixel
;
6654 p
->next
= ct_table
[i
];
6658 return FRAME_FOREGROUND_PIXEL (f
);
6665 /* Look up pixel color PIXEL which is used on frame F in the color
6666 table. If not already present, allocate it. Value is PIXEL. */
6668 static unsigned long
6669 lookup_pixel_color (f
, pixel
)
6671 unsigned long pixel
;
6673 int i
= pixel
% CT_SIZE
;
6676 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6677 if (p
->pixel
== pixel
)
6688 cmap
= FRAME_X_COLORMAP (f
);
6689 color
.pixel
= pixel
;
6690 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
6691 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6696 ++ct_colors_allocated
;
6698 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6703 p
->next
= ct_table
[i
];
6707 return FRAME_FOREGROUND_PIXEL (f
);
6714 /* Value is a vector of all pixel colors contained in the color table,
6715 allocated via xmalloc. Set *N to the number of colors. */
6717 static unsigned long *
6718 colors_in_color_table (n
)
6723 unsigned long *colors
;
6725 if (ct_colors_allocated
== 0)
6732 colors
= (unsigned long *) xmalloc (ct_colors_allocated
6734 *n
= ct_colors_allocated
;
6736 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
6737 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6738 colors
[j
++] = p
->pixel
;
6746 /***********************************************************************
6748 ***********************************************************************/
6750 static void x_laplace_write_row
P_ ((struct frame
*, long *,
6751 int, XImage
*, int));
6752 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
6753 XColor
*, int, XImage
*, int));
6756 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6757 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6758 the width of one row in the image. */
6761 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
6771 for (x
= 0; x
< width
; ++x
)
6772 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
6774 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
6778 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
6779 containing the pixel colors to write. F is the frame we are
6783 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
6792 for (x
= 0; x
< width
; ++x
)
6793 XPutPixel (ximg
, x
, y
, pixels
[x
]);
6797 /* Transform image IMG which is used on frame F with a Laplace
6798 edge-detection algorithm. The result is an image that can be used
6799 to draw disabled buttons, for example. */
6806 Colormap cmap
= FRAME_X_COLORMAP (f
);
6807 XImage
*ximg
, *oimg
;
6813 int in_y
, out_y
, rc
;
6818 /* Get the X image IMG->pixmap. */
6819 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
6820 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
6822 /* Allocate 3 input rows, and one output row of colors. */
6823 for (i
= 0; i
< 3; ++i
)
6824 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
6825 out
= (long *) alloca (img
->width
* sizeof (long));
6827 /* Create an X image for output. */
6828 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
6831 /* Fill first two rows. */
6832 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
6833 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
6836 /* Write first row, all zeros. */
6837 init_color_table ();
6838 pixel
= lookup_rgb_color (f
, 0, 0, 0);
6839 for (x
= 0; x
< img
->width
; ++x
)
6841 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
6844 for (y
= 2; y
< img
->height
; ++y
)
6847 int rowb
= (y
+ 2) % 3;
6849 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
6851 for (x
= 0; x
< img
->width
- 2; ++x
)
6853 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
6854 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
6855 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
6857 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
6861 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
6864 /* Write last line, all zeros. */
6865 for (x
= 0; x
< img
->width
; ++x
)
6867 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
6869 /* Free the input image, and free resources of IMG. */
6870 XDestroyImage (ximg
);
6871 x_clear_image (f
, img
);
6873 /* Put the output image into pixmap, and destroy it. */
6874 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
6875 x_destroy_x_image (oimg
);
6877 /* Remember new pixmap and colors in IMG. */
6878 img
->pixmap
= pixmap
;
6879 img
->colors
= colors_in_color_table (&img
->ncolors
);
6880 free_color_table ();
6886 /* Build a mask for image IMG which is used on frame F. FILE is the
6887 name of an image file, for error messages. HOW determines how to
6888 determine the background color of IMG. If it is a list '(R G B)',
6889 with R, G, and B being integers >= 0, take that as the color of the
6890 background. Otherwise, determine the background color of IMG
6891 heuristically. Value is non-zero if successful. */
6894 x_build_heuristic_mask (f
, img
, how
)
6899 Display
*dpy
= FRAME_X_DISPLAY (f
);
6900 XImage
*ximg
, *mask_img
;
6901 int x
, y
, rc
, look_at_corners_p
;
6906 /* Create an image and pixmap serving as mask. */
6907 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
6908 &mask_img
, &img
->mask
);
6915 /* Get the X image of IMG->pixmap. */
6916 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
6919 /* Determine the background color of ximg. If HOW is `(R G B)'
6920 take that as color. Otherwise, try to determine the color
6922 look_at_corners_p
= 1;
6930 && NATNUMP (XCAR (how
)))
6932 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
6936 if (i
== 3 && NILP (how
))
6938 char color_name
[30];
6939 XColor exact
, color
;
6942 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
6944 cmap
= FRAME_X_COLORMAP (f
);
6945 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
6948 look_at_corners_p
= 0;
6953 if (look_at_corners_p
)
6955 unsigned long corners
[4];
6958 /* Get the colors at the corners of ximg. */
6959 corners
[0] = XGetPixel (ximg
, 0, 0);
6960 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
6961 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
6962 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
6964 /* Choose the most frequently found color as background. */
6965 for (i
= best_count
= 0; i
< 4; ++i
)
6969 for (j
= n
= 0; j
< 4; ++j
)
6970 if (corners
[i
] == corners
[j
])
6974 bg
= corners
[i
], best_count
= n
;
6978 /* Set all bits in mask_img to 1 whose color in ximg is different
6979 from the background color bg. */
6980 for (y
= 0; y
< img
->height
; ++y
)
6981 for (x
= 0; x
< img
->width
; ++x
)
6982 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
6984 /* Put mask_img into img->mask. */
6985 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
6986 x_destroy_x_image (mask_img
);
6987 XDestroyImage (ximg
);
6995 /***********************************************************************
6996 PBM (mono, gray, color)
6997 ***********************************************************************/
6999 static int pbm_image_p
P_ ((Lisp_Object object
));
7000 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7001 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7003 /* The symbol `pbm' identifying images of this type. */
7007 /* Indices of image specification fields in gs_format, below. */
7009 enum pbm_keyword_index
7022 /* Vector of image_keyword structures describing the format
7023 of valid user-defined image specifications. */
7025 static struct image_keyword pbm_format
[PBM_LAST
] =
7027 {":type", IMAGE_SYMBOL_VALUE
, 1},
7028 {":file", IMAGE_STRING_VALUE
, 0},
7029 {":data", IMAGE_STRING_VALUE
, 0},
7030 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7031 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7032 {":relief", IMAGE_INTEGER_VALUE
, 0},
7033 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7034 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7037 /* Structure describing the image type `pbm'. */
7039 static struct image_type pbm_type
=
7049 /* Return non-zero if OBJECT is a valid PBM image specification. */
7052 pbm_image_p (object
)
7055 struct image_keyword fmt
[PBM_LAST
];
7057 bcopy (pbm_format
, fmt
, sizeof fmt
);
7059 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7060 || (fmt
[PBM_ASCENT
].count
7061 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7064 /* Must specify either :data or :file. */
7065 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7069 /* Scan a decimal number from *S and return it. Advance *S while
7070 reading the number. END is the end of the string. Value is -1 at
7074 pbm_scan_number (s
, end
)
7075 unsigned char **s
, *end
;
7081 /* Skip white-space. */
7082 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7087 /* Skip comment to end of line. */
7088 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7091 else if (isdigit (c
))
7093 /* Read decimal number. */
7095 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7096 val
= 10 * val
+ c
- '0';
7107 /* Read FILE into memory. Value is a pointer to a buffer allocated
7108 with xmalloc holding FILE's contents. Value is null if an error
7109 occured. *SIZE is set to the size of the file. */
7112 pbm_read_file (file
, size
)
7120 if (stat (XSTRING (file
)->data
, &st
) == 0
7121 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
7122 && (buf
= (char *) xmalloc (st
.st_size
),
7123 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
7143 /* Load PBM image IMG for use on frame F. */
7151 int width
, height
, max_color_idx
= 0;
7153 Lisp_Object file
, specified_file
;
7154 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7155 struct gcpro gcpro1
;
7156 unsigned char *contents
= NULL
;
7157 unsigned char *end
, *p
;
7160 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7164 if (STRINGP (specified_file
))
7166 file
= x_find_image_file (specified_file
);
7167 if (!STRINGP (file
))
7169 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7174 contents
= pbm_read_file (file
, &size
);
7175 if (contents
== NULL
)
7177 image_error ("Error reading `%s'", file
, Qnil
);
7183 end
= contents
+ size
;
7188 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7189 p
= XSTRING (data
)->data
;
7190 end
= p
+ STRING_BYTES (XSTRING (data
));
7193 /* Check magic number. */
7194 if (end
- p
< 2 || *p
++ != 'P')
7196 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7206 raw_p
= 0, type
= PBM_MONO
;
7210 raw_p
= 0, type
= PBM_GRAY
;
7214 raw_p
= 0, type
= PBM_COLOR
;
7218 raw_p
= 1, type
= PBM_MONO
;
7222 raw_p
= 1, type
= PBM_GRAY
;
7226 raw_p
= 1, type
= PBM_COLOR
;
7230 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7234 /* Read width, height, maximum color-component. Characters
7235 starting with `#' up to the end of a line are ignored. */
7236 width
= pbm_scan_number (&p
, end
);
7237 height
= pbm_scan_number (&p
, end
);
7239 if (type
!= PBM_MONO
)
7241 max_color_idx
= pbm_scan_number (&p
, end
);
7242 if (raw_p
&& max_color_idx
> 255)
7243 max_color_idx
= 255;
7248 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7252 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7253 &ximg
, &img
->pixmap
))
7259 /* Initialize the color hash table. */
7260 init_color_table ();
7262 if (type
== PBM_MONO
)
7266 for (y
= 0; y
< height
; ++y
)
7267 for (x
= 0; x
< width
; ++x
)
7277 g
= pbm_scan_number (&p
, end
);
7279 XPutPixel (ximg
, x
, y
, (g
7280 ? FRAME_FOREGROUND_PIXEL (f
)
7281 : FRAME_BACKGROUND_PIXEL (f
)));
7286 for (y
= 0; y
< height
; ++y
)
7287 for (x
= 0; x
< width
; ++x
)
7291 if (type
== PBM_GRAY
)
7292 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7301 r
= pbm_scan_number (&p
, end
);
7302 g
= pbm_scan_number (&p
, end
);
7303 b
= pbm_scan_number (&p
, end
);
7306 if (r
< 0 || g
< 0 || b
< 0)
7310 XDestroyImage (ximg
);
7312 image_error ("Invalid pixel value in image `%s'",
7317 /* RGB values are now in the range 0..max_color_idx.
7318 Scale this to the range 0..0xffff supported by X. */
7319 r
= (double) r
* 65535 / max_color_idx
;
7320 g
= (double) g
* 65535 / max_color_idx
;
7321 b
= (double) b
* 65535 / max_color_idx
;
7322 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7326 /* Store in IMG->colors the colors allocated for the image, and
7327 free the color table. */
7328 img
->colors
= colors_in_color_table (&img
->ncolors
);
7329 free_color_table ();
7331 /* Put the image into a pixmap. */
7332 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7333 x_destroy_x_image (ximg
);
7337 img
->height
= height
;
7346 /***********************************************************************
7348 ***********************************************************************/
7354 /* Function prototypes. */
7356 static int png_image_p
P_ ((Lisp_Object object
));
7357 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7359 /* The symbol `png' identifying images of this type. */
7363 /* Indices of image specification fields in png_format, below. */
7365 enum png_keyword_index
7378 /* Vector of image_keyword structures describing the format
7379 of valid user-defined image specifications. */
7381 static struct image_keyword png_format
[PNG_LAST
] =
7383 {":type", IMAGE_SYMBOL_VALUE
, 1},
7384 {":data", IMAGE_STRING_VALUE
, 0},
7385 {":file", IMAGE_STRING_VALUE
, 0},
7386 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7387 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7388 {":relief", IMAGE_INTEGER_VALUE
, 0},
7389 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7390 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7393 /* Structure describing the image type `png'. */
7395 static struct image_type png_type
=
7405 /* Return non-zero if OBJECT is a valid PNG image specification. */
7408 png_image_p (object
)
7411 struct image_keyword fmt
[PNG_LAST
];
7412 bcopy (png_format
, fmt
, sizeof fmt
);
7414 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
7415 || (fmt
[PNG_ASCENT
].count
7416 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7419 /* Must specify either the :data or :file keyword. */
7420 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
7424 /* Error and warning handlers installed when the PNG library
7428 my_png_error (png_ptr
, msg
)
7429 png_struct
*png_ptr
;
7432 xassert (png_ptr
!= NULL
);
7433 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7434 longjmp (png_ptr
->jmpbuf
, 1);
7439 my_png_warning (png_ptr
, msg
)
7440 png_struct
*png_ptr
;
7443 xassert (png_ptr
!= NULL
);
7444 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
7447 /* Memory source for PNG decoding. */
7449 struct png_memory_storage
7451 unsigned char *bytes
; /* The data */
7452 size_t len
; /* How big is it? */
7453 int index
; /* Where are we? */
7457 /* Function set as reader function when reading PNG image from memory.
7458 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7459 bytes from the input to DATA. */
7462 png_read_from_memory (png_ptr
, data
, length
)
7463 png_structp png_ptr
;
7467 struct png_memory_storage
*tbr
7468 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
7470 if (length
> tbr
->len
- tbr
->index
)
7471 png_error (png_ptr
, "Read error");
7473 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
7474 tbr
->index
= tbr
->index
+ length
;
7477 /* Load PNG image IMG for use on frame F. Value is non-zero if
7485 Lisp_Object file
, specified_file
;
7486 Lisp_Object specified_data
;
7488 XImage
*ximg
, *mask_img
= NULL
;
7489 struct gcpro gcpro1
;
7490 png_struct
*png_ptr
= NULL
;
7491 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
7494 png_byte
*pixels
= NULL
;
7495 png_byte
**rows
= NULL
;
7496 png_uint_32 width
, height
;
7497 int bit_depth
, color_type
, interlace_type
;
7499 png_uint_32 row_bytes
;
7502 double screen_gamma
, image_gamma
;
7504 struct png_memory_storage tbr
; /* Data to be read */
7506 /* Find out what file to load. */
7507 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7508 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7512 if (NILP (specified_data
))
7514 file
= x_find_image_file (specified_file
);
7515 if (!STRINGP (file
))
7517 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7522 /* Open the image file. */
7523 fp
= fopen (XSTRING (file
)->data
, "rb");
7526 image_error ("Cannot open image file `%s'", file
, Qnil
);
7532 /* Check PNG signature. */
7533 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
7534 || !png_check_sig (sig
, sizeof sig
))
7536 image_error ("Not a PNG file: `%s'", file
, Qnil
);
7544 /* Read from memory. */
7545 tbr
.bytes
= XSTRING (specified_data
)->data
;
7546 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
7549 /* Check PNG signature. */
7550 if (tbr
.len
< sizeof sig
7551 || !png_check_sig (tbr
.bytes
, sizeof sig
))
7553 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
7558 /* Need to skip past the signature. */
7559 tbr
.bytes
+= sizeof (sig
);
7562 /* Initialize read and info structs for PNG lib. */
7563 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
7564 my_png_error
, my_png_warning
);
7567 if (fp
) fclose (fp
);
7572 info_ptr
= png_create_info_struct (png_ptr
);
7575 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
7576 if (fp
) fclose (fp
);
7581 end_info
= png_create_info_struct (png_ptr
);
7584 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
7585 if (fp
) fclose (fp
);
7590 /* Set error jump-back. We come back here when the PNG library
7591 detects an error. */
7592 if (setjmp (png_ptr
->jmpbuf
))
7596 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7599 if (fp
) fclose (fp
);
7604 /* Read image info. */
7605 if (!NILP (specified_data
))
7606 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
7608 png_init_io (png_ptr
, fp
);
7610 png_set_sig_bytes (png_ptr
, sizeof sig
);
7611 png_read_info (png_ptr
, info_ptr
);
7612 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
7613 &interlace_type
, NULL
, NULL
);
7615 /* If image contains simply transparency data, we prefer to
7616 construct a clipping mask. */
7617 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
7622 /* This function is easier to write if we only have to handle
7623 one data format: RGB or RGBA with 8 bits per channel. Let's
7624 transform other formats into that format. */
7626 /* Strip more than 8 bits per channel. */
7627 if (bit_depth
== 16)
7628 png_set_strip_16 (png_ptr
);
7630 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7632 png_set_expand (png_ptr
);
7634 /* Convert grayscale images to RGB. */
7635 if (color_type
== PNG_COLOR_TYPE_GRAY
7636 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
7637 png_set_gray_to_rgb (png_ptr
);
7639 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7640 gamma_str
= getenv ("SCREEN_GAMMA");
7641 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
7643 /* Tell the PNG lib to handle gamma correction for us. */
7645 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7646 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
7647 /* There is a special chunk in the image specifying the gamma. */
7648 png_set_sRGB (png_ptr
, info_ptr
, intent
);
7651 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
7652 /* Image contains gamma information. */
7653 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
7655 /* Use a default of 0.5 for the image gamma. */
7656 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
7658 /* Handle alpha channel by combining the image with a background
7659 color. Do this only if a real alpha channel is supplied. For
7660 simple transparency, we prefer a clipping mask. */
7663 png_color_16
*image_background
;
7665 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
7666 /* Image contains a background color with which to
7667 combine the image. */
7668 png_set_background (png_ptr
, image_background
,
7669 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
7672 /* Image does not contain a background color with which
7673 to combine the image data via an alpha channel. Use
7674 the frame's background instead. */
7677 png_color_16 frame_background
;
7680 cmap
= FRAME_X_COLORMAP (f
);
7681 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
7682 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7685 bzero (&frame_background
, sizeof frame_background
);
7686 frame_background
.red
= color
.red
;
7687 frame_background
.green
= color
.green
;
7688 frame_background
.blue
= color
.blue
;
7690 png_set_background (png_ptr
, &frame_background
,
7691 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
7695 /* Update info structure. */
7696 png_read_update_info (png_ptr
, info_ptr
);
7698 /* Get number of channels. Valid values are 1 for grayscale images
7699 and images with a palette, 2 for grayscale images with transparency
7700 information (alpha channel), 3 for RGB images, and 4 for RGB
7701 images with alpha channel, i.e. RGBA. If conversions above were
7702 sufficient we should only have 3 or 4 channels here. */
7703 channels
= png_get_channels (png_ptr
, info_ptr
);
7704 xassert (channels
== 3 || channels
== 4);
7706 /* Number of bytes needed for one row of the image. */
7707 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
7709 /* Allocate memory for the image. */
7710 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
7711 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
7712 for (i
= 0; i
< height
; ++i
)
7713 rows
[i
] = pixels
+ i
* row_bytes
;
7715 /* Read the entire image. */
7716 png_read_image (png_ptr
, rows
);
7717 png_read_end (png_ptr
, info_ptr
);
7726 /* Create the X image and pixmap. */
7727 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
7734 /* Create an image and pixmap serving as mask if the PNG image
7735 contains an alpha channel. */
7738 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
7739 &mask_img
, &img
->mask
))
7741 x_destroy_x_image (ximg
);
7742 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
7748 /* Fill the X image and mask from PNG data. */
7749 init_color_table ();
7751 for (y
= 0; y
< height
; ++y
)
7753 png_byte
*p
= rows
[y
];
7755 for (x
= 0; x
< width
; ++x
)
7762 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7764 /* An alpha channel, aka mask channel, associates variable
7765 transparency with an image. Where other image formats
7766 support binary transparency---fully transparent or fully
7767 opaque---PNG allows up to 254 levels of partial transparency.
7768 The PNG library implements partial transparency by combining
7769 the image with a specified background color.
7771 I'm not sure how to handle this here nicely: because the
7772 background on which the image is displayed may change, for
7773 real alpha channel support, it would be necessary to create
7774 a new image for each possible background.
7776 What I'm doing now is that a mask is created if we have
7777 boolean transparency information. Otherwise I'm using
7778 the frame's background color to combine the image with. */
7783 XPutPixel (mask_img
, x
, y
, *p
> 0);
7789 /* Remember colors allocated for this image. */
7790 img
->colors
= colors_in_color_table (&img
->ncolors
);
7791 free_color_table ();
7794 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7799 img
->height
= height
;
7801 /* Put the image into the pixmap, then free the X image and its buffer. */
7802 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7803 x_destroy_x_image (ximg
);
7805 /* Same for the mask. */
7808 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7809 x_destroy_x_image (mask_img
);
7817 #endif /* HAVE_PNG != 0 */
7821 /***********************************************************************
7823 ***********************************************************************/
7827 /* Work around a warning about HAVE_STDLIB_H being redefined in
7829 #ifdef HAVE_STDLIB_H
7830 #define HAVE_STDLIB_H_1
7831 #undef HAVE_STDLIB_H
7832 #endif /* HAVE_STLIB_H */
7834 #include <jpeglib.h>
7838 #ifdef HAVE_STLIB_H_1
7839 #define HAVE_STDLIB_H 1
7842 static int jpeg_image_p
P_ ((Lisp_Object object
));
7843 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
7845 /* The symbol `jpeg' identifying images of this type. */
7849 /* Indices of image specification fields in gs_format, below. */
7851 enum jpeg_keyword_index
7860 JPEG_HEURISTIC_MASK
,
7864 /* Vector of image_keyword structures describing the format
7865 of valid user-defined image specifications. */
7867 static struct image_keyword jpeg_format
[JPEG_LAST
] =
7869 {":type", IMAGE_SYMBOL_VALUE
, 1},
7870 {":data", IMAGE_STRING_VALUE
, 0},
7871 {":file", IMAGE_STRING_VALUE
, 0},
7872 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7873 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7874 {":relief", IMAGE_INTEGER_VALUE
, 0},
7875 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7876 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7879 /* Structure describing the image type `jpeg'. */
7881 static struct image_type jpeg_type
=
7891 /* Return non-zero if OBJECT is a valid JPEG image specification. */
7894 jpeg_image_p (object
)
7897 struct image_keyword fmt
[JPEG_LAST
];
7899 bcopy (jpeg_format
, fmt
, sizeof fmt
);
7901 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
7902 || (fmt
[JPEG_ASCENT
].count
7903 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
7906 /* Must specify either the :data or :file keyword. */
7907 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
7911 struct my_jpeg_error_mgr
7913 struct jpeg_error_mgr pub
;
7914 jmp_buf setjmp_buffer
;
7918 my_error_exit (cinfo
)
7921 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
7922 longjmp (mgr
->setjmp_buffer
, 1);
7925 /* Init source method for JPEG data source manager. Called by
7926 jpeg_read_header() before any data is actually read. See
7927 libjpeg.doc from the JPEG lib distribution. */
7930 our_init_source (cinfo
)
7931 j_decompress_ptr cinfo
;
7936 /* Fill input buffer method for JPEG data source manager. Called
7937 whenever more data is needed. We read the whole image in one step,
7938 so this only adds a fake end of input marker at the end. */
7941 our_fill_input_buffer (cinfo
)
7942 j_decompress_ptr cinfo
;
7944 /* Insert a fake EOI marker. */
7945 struct jpeg_source_mgr
*src
= cinfo
->src
;
7946 static JOCTET buffer
[2];
7948 buffer
[0] = (JOCTET
) 0xFF;
7949 buffer
[1] = (JOCTET
) JPEG_EOI
;
7951 src
->next_input_byte
= buffer
;
7952 src
->bytes_in_buffer
= 2;
7957 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
7958 is the JPEG data source manager. */
7961 our_skip_input_data (cinfo
, num_bytes
)
7962 j_decompress_ptr cinfo
;
7965 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
7969 if (num_bytes
> src
->bytes_in_buffer
)
7970 ERREXIT (cinfo
, JERR_INPUT_EOF
);
7972 src
->bytes_in_buffer
-= num_bytes
;
7973 src
->next_input_byte
+= num_bytes
;
7978 /* Method to terminate data source. Called by
7979 jpeg_finish_decompress() after all data has been processed. */
7982 our_term_source (cinfo
)
7983 j_decompress_ptr cinfo
;
7988 /* Set up the JPEG lib for reading an image from DATA which contains
7989 LEN bytes. CINFO is the decompression info structure created for
7990 reading the image. */
7993 jpeg_memory_src (cinfo
, data
, len
)
7994 j_decompress_ptr cinfo
;
7998 struct jpeg_source_mgr
*src
;
8000 if (cinfo
->src
== NULL
)
8002 /* First time for this JPEG object? */
8003 cinfo
->src
= (struct jpeg_source_mgr
*)
8004 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8005 sizeof (struct jpeg_source_mgr
));
8006 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8007 src
->next_input_byte
= data
;
8010 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8011 src
->init_source
= our_init_source
;
8012 src
->fill_input_buffer
= our_fill_input_buffer
;
8013 src
->skip_input_data
= our_skip_input_data
;
8014 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8015 src
->term_source
= our_term_source
;
8016 src
->bytes_in_buffer
= len
;
8017 src
->next_input_byte
= data
;
8021 /* Load image IMG for use on frame F. Patterned after example.c
8022 from the JPEG lib. */
8029 struct jpeg_decompress_struct cinfo
;
8030 struct my_jpeg_error_mgr mgr
;
8031 Lisp_Object file
, specified_file
;
8032 Lisp_Object specified_data
;
8035 int row_stride
, x
, y
;
8036 XImage
*ximg
= NULL
;
8038 unsigned long *colors
;
8040 struct gcpro gcpro1
;
8042 /* Open the JPEG file. */
8043 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8044 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8048 if (NILP (specified_data
))
8050 file
= x_find_image_file (specified_file
);
8051 if (!STRINGP (file
))
8053 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8058 fp
= fopen (XSTRING (file
)->data
, "r");
8061 image_error ("Cannot open `%s'", file
, Qnil
);
8067 /* Customize libjpeg's error handling to call my_error_exit when an
8068 error is detected. This function will perform a longjmp. */
8069 mgr
.pub
.error_exit
= my_error_exit
;
8070 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8072 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8076 /* Called from my_error_exit. Display a JPEG error. */
8077 char buffer
[JMSG_LENGTH_MAX
];
8078 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8079 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8080 build_string (buffer
));
8083 /* Close the input file and destroy the JPEG object. */
8086 jpeg_destroy_decompress (&cinfo
);
8090 /* If we already have an XImage, free that. */
8091 x_destroy_x_image (ximg
);
8093 /* Free pixmap and colors. */
8094 x_clear_image (f
, img
);
8101 /* Create the JPEG decompression object. Let it read from fp.
8102 Read the JPEG image header. */
8103 jpeg_create_decompress (&cinfo
);
8105 if (NILP (specified_data
))
8106 jpeg_stdio_src (&cinfo
, fp
);
8108 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8109 STRING_BYTES (XSTRING (specified_data
)));
8111 jpeg_read_header (&cinfo
, TRUE
);
8113 /* Customize decompression so that color quantization will be used.
8114 Start decompression. */
8115 cinfo
.quantize_colors
= TRUE
;
8116 jpeg_start_decompress (&cinfo
);
8117 width
= img
->width
= cinfo
.output_width
;
8118 height
= img
->height
= cinfo
.output_height
;
8122 /* Create X image and pixmap. */
8123 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8126 longjmp (mgr
.setjmp_buffer
, 2);
8129 /* Allocate colors. When color quantization is used,
8130 cinfo.actual_number_of_colors has been set with the number of
8131 colors generated, and cinfo.colormap is a two-dimensional array
8132 of color indices in the range 0..cinfo.actual_number_of_colors.
8133 No more than 255 colors will be generated. */
8137 if (cinfo
.out_color_components
> 2)
8138 ir
= 0, ig
= 1, ib
= 2;
8139 else if (cinfo
.out_color_components
> 1)
8140 ir
= 0, ig
= 1, ib
= 0;
8142 ir
= 0, ig
= 0, ib
= 0;
8144 /* Use the color table mechanism because it handles colors that
8145 cannot be allocated nicely. Such colors will be replaced with
8146 a default color, and we don't have to care about which colors
8147 can be freed safely, and which can't. */
8148 init_color_table ();
8149 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8152 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8154 /* Multiply RGB values with 255 because X expects RGB values
8155 in the range 0..0xffff. */
8156 int r
= cinfo
.colormap
[ir
][i
] << 8;
8157 int g
= cinfo
.colormap
[ig
][i
] << 8;
8158 int b
= cinfo
.colormap
[ib
][i
] << 8;
8159 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8162 /* Remember those colors actually allocated. */
8163 img
->colors
= colors_in_color_table (&img
->ncolors
);
8164 free_color_table ();
8168 row_stride
= width
* cinfo
.output_components
;
8169 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8171 for (y
= 0; y
< height
; ++y
)
8173 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8174 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8175 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8179 jpeg_finish_decompress (&cinfo
);
8180 jpeg_destroy_decompress (&cinfo
);
8184 /* Put the image into the pixmap. */
8185 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8186 x_destroy_x_image (ximg
);
8192 #endif /* HAVE_JPEG */
8196 /***********************************************************************
8198 ***********************************************************************/
8204 static int tiff_image_p
P_ ((Lisp_Object object
));
8205 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8207 /* The symbol `tiff' identifying images of this type. */
8211 /* Indices of image specification fields in tiff_format, below. */
8213 enum tiff_keyword_index
8222 TIFF_HEURISTIC_MASK
,
8226 /* Vector of image_keyword structures describing the format
8227 of valid user-defined image specifications. */
8229 static struct image_keyword tiff_format
[TIFF_LAST
] =
8231 {":type", IMAGE_SYMBOL_VALUE
, 1},
8232 {":data", IMAGE_STRING_VALUE
, 0},
8233 {":file", IMAGE_STRING_VALUE
, 0},
8234 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8235 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8236 {":relief", IMAGE_INTEGER_VALUE
, 0},
8237 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8238 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8241 /* Structure describing the image type `tiff'. */
8243 static struct image_type tiff_type
=
8253 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8256 tiff_image_p (object
)
8259 struct image_keyword fmt
[TIFF_LAST
];
8260 bcopy (tiff_format
, fmt
, sizeof fmt
);
8262 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
8263 || (fmt
[TIFF_ASCENT
].count
8264 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8267 /* Must specify either the :data or :file keyword. */
8268 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8272 /* Reading from a memory buffer for TIFF images Based on the PNG
8273 memory source, but we have to provide a lot of extra functions.
8276 We really only need to implement read and seek, but I am not
8277 convinced that the TIFF library is smart enough not to destroy
8278 itself if we only hand it the function pointers we need to
8283 unsigned char *bytes
;
8290 tiff_read_from_memory (data
, buf
, size
)
8295 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8297 if (size
> src
->len
- src
->index
)
8299 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8305 tiff_write_from_memory (data
, buf
, size
)
8314 tiff_seek_in_memory (data
, off
, whence
)
8319 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8324 case SEEK_SET
: /* Go from beginning of source. */
8328 case SEEK_END
: /* Go from end of source. */
8329 idx
= src
->len
+ off
;
8332 case SEEK_CUR
: /* Go from current position. */
8333 idx
= src
->index
+ off
;
8336 default: /* Invalid `whence'. */
8340 if (idx
> src
->len
|| idx
< 0)
8348 tiff_close_memory (data
)
8356 tiff_mmap_memory (data
, pbase
, psize
)
8361 /* It is already _IN_ memory. */
8366 tiff_unmap_memory (data
, base
, size
)
8371 /* We don't need to do this. */
8375 tiff_size_of_memory (data
)
8378 return ((tiff_memory_source
*) data
)->len
;
8381 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8389 Lisp_Object file
, specified_file
;
8390 Lisp_Object specified_data
;
8392 int width
, height
, x
, y
;
8396 struct gcpro gcpro1
;
8397 tiff_memory_source memsrc
;
8399 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8400 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8404 if (NILP (specified_data
))
8406 /* Read from a file */
8407 file
= x_find_image_file (specified_file
);
8408 if (!STRINGP (file
))
8410 image_error ("Cannot find image file `%s'", file
, Qnil
);
8415 /* Try to open the image file. */
8416 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8419 image_error ("Cannot open `%s'", file
, Qnil
);
8426 /* Memory source! */
8427 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8428 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8431 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
8432 (TIFFReadWriteProc
) tiff_read_from_memory
,
8433 (TIFFReadWriteProc
) tiff_write_from_memory
,
8434 tiff_seek_in_memory
,
8436 tiff_size_of_memory
,
8442 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
8448 /* Get width and height of the image, and allocate a raster buffer
8449 of width x height 32-bit values. */
8450 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8451 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8452 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8454 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8458 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
8466 /* Create the X image and pixmap. */
8467 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8475 /* Initialize the color table. */
8476 init_color_table ();
8478 /* Process the pixel raster. Origin is in the lower-left corner. */
8479 for (y
= 0; y
< height
; ++y
)
8481 uint32
*row
= buf
+ y
* width
;
8483 for (x
= 0; x
< width
; ++x
)
8485 uint32 abgr
= row
[x
];
8486 int r
= TIFFGetR (abgr
) << 8;
8487 int g
= TIFFGetG (abgr
) << 8;
8488 int b
= TIFFGetB (abgr
) << 8;
8489 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8493 /* Remember the colors allocated for the image. Free the color table. */
8494 img
->colors
= colors_in_color_table (&img
->ncolors
);
8495 free_color_table ();
8497 /* Put the image into the pixmap, then free the X image and its buffer. */
8498 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8499 x_destroy_x_image (ximg
);
8504 img
->height
= height
;
8510 #endif /* HAVE_TIFF != 0 */
8514 /***********************************************************************
8516 ***********************************************************************/
8520 #include <gif_lib.h>
8522 static int gif_image_p
P_ ((Lisp_Object object
));
8523 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8525 /* The symbol `gif' identifying images of this type. */
8529 /* Indices of image specification fields in gif_format, below. */
8531 enum gif_keyword_index
8545 /* Vector of image_keyword structures describing the format
8546 of valid user-defined image specifications. */
8548 static struct image_keyword gif_format
[GIF_LAST
] =
8550 {":type", IMAGE_SYMBOL_VALUE
, 1},
8551 {":data", IMAGE_STRING_VALUE
, 0},
8552 {":file", IMAGE_STRING_VALUE
, 0},
8553 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8554 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8555 {":relief", IMAGE_INTEGER_VALUE
, 0},
8556 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8557 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8558 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8561 /* Structure describing the image type `gif'. */
8563 static struct image_type gif_type
=
8572 /* Return non-zero if OBJECT is a valid GIF image specification. */
8575 gif_image_p (object
)
8578 struct image_keyword fmt
[GIF_LAST
];
8579 bcopy (gif_format
, fmt
, sizeof fmt
);
8581 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
8582 || (fmt
[GIF_ASCENT
].count
8583 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8586 /* Must specify either the :data or :file keyword. */
8587 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
8590 /* Reading a GIF image from memory
8591 Based on the PNG memory stuff to a certain extent. */
8595 unsigned char *bytes
;
8601 /* Make the current memory source available to gif_read_from_memory.
8602 It's done this way because not all versions of libungif support
8603 a UserData field in the GifFileType structure. */
8604 static gif_memory_source
*current_gif_memory_src
;
8607 gif_read_from_memory (file
, buf
, len
)
8612 gif_memory_source
*src
= current_gif_memory_src
;
8614 if (len
> src
->len
- src
->index
)
8617 bcopy (src
->bytes
+ src
->index
, buf
, len
);
8623 /* Load GIF image IMG for use on frame F. Value is non-zero if
8631 Lisp_Object file
, specified_file
;
8632 Lisp_Object specified_data
;
8633 int rc
, width
, height
, x
, y
, i
;
8635 ColorMapObject
*gif_color_map
;
8636 unsigned long pixel_colors
[256];
8638 struct gcpro gcpro1
;
8640 int ino
, image_left
, image_top
, image_width
, image_height
;
8641 gif_memory_source memsrc
;
8642 unsigned char *raster
;
8644 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8645 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8649 if (NILP (specified_data
))
8651 file
= x_find_image_file (specified_file
);
8652 if (!STRINGP (file
))
8654 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8659 /* Open the GIF file. */
8660 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8663 image_error ("Cannot open `%s'", file
, Qnil
);
8670 /* Read from memory! */
8671 current_gif_memory_src
= &memsrc
;
8672 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8673 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8676 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
8679 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
8685 /* Read entire contents. */
8686 rc
= DGifSlurp (gif
);
8687 if (rc
== GIF_ERROR
)
8689 image_error ("Error reading `%s'", img
->spec
, Qnil
);
8690 DGifCloseFile (gif
);
8695 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8696 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8697 if (ino
>= gif
->ImageCount
)
8699 image_error ("Invalid image number `%s' in image `%s'",
8701 DGifCloseFile (gif
);
8706 width
= img
->width
= gif
->SWidth
;
8707 height
= img
->height
= gif
->SHeight
;
8711 /* Create the X image and pixmap. */
8712 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8715 DGifCloseFile (gif
);
8720 /* Allocate colors. */
8721 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8723 gif_color_map
= gif
->SColorMap
;
8724 init_color_table ();
8725 bzero (pixel_colors
, sizeof pixel_colors
);
8727 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8729 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8730 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8731 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8732 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8735 img
->colors
= colors_in_color_table (&img
->ncolors
);
8736 free_color_table ();
8738 /* Clear the part of the screen image that are not covered by
8739 the image from the GIF file. Full animated GIF support
8740 requires more than can be done here (see the gif89 spec,
8741 disposal methods). Let's simply assume that the part
8742 not covered by a sub-image is in the frame's background color. */
8743 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8744 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8745 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8746 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8748 for (y
= 0; y
< image_top
; ++y
)
8749 for (x
= 0; x
< width
; ++x
)
8750 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8752 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8753 for (x
= 0; x
< width
; ++x
)
8754 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8756 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8758 for (x
= 0; x
< image_left
; ++x
)
8759 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8760 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8761 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8764 /* Read the GIF image into the X image. We use a local variable
8765 `raster' here because RasterBits below is a char *, and invites
8766 problems with bytes >= 0x80. */
8767 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
8769 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8771 static int interlace_start
[] = {0, 4, 2, 1};
8772 static int interlace_increment
[] = {8, 8, 4, 2};
8774 int row
= interlace_start
[0];
8778 for (y
= 0; y
< image_height
; y
++)
8780 if (row
>= image_height
)
8782 row
= interlace_start
[++pass
];
8783 while (row
>= image_height
)
8784 row
= interlace_start
[++pass
];
8787 for (x
= 0; x
< image_width
; x
++)
8789 int i
= raster
[(y
* image_width
) + x
];
8790 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8794 row
+= interlace_increment
[pass
];
8799 for (y
= 0; y
< image_height
; ++y
)
8800 for (x
= 0; x
< image_width
; ++x
)
8802 int i
= raster
[y
* image_width
+ x
];
8803 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8807 DGifCloseFile (gif
);
8809 /* Put the image into the pixmap, then free the X image and its buffer. */
8810 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8811 x_destroy_x_image (ximg
);
8818 #endif /* HAVE_GIF != 0 */
8822 /***********************************************************************
8824 ***********************************************************************/
8826 static int gs_image_p
P_ ((Lisp_Object object
));
8827 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8828 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8830 /* The symbol `postscript' identifying images of this type. */
8832 Lisp_Object Qpostscript
;
8834 /* Keyword symbols. */
8836 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
8838 /* Indices of image specification fields in gs_format, below. */
8840 enum gs_keyword_index
8856 /* Vector of image_keyword structures describing the format
8857 of valid user-defined image specifications. */
8859 static struct image_keyword gs_format
[GS_LAST
] =
8861 {":type", IMAGE_SYMBOL_VALUE
, 1},
8862 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
8863 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
8864 {":file", IMAGE_STRING_VALUE
, 1},
8865 {":loader", IMAGE_FUNCTION_VALUE
, 0},
8866 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
8867 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8868 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8869 {":relief", IMAGE_INTEGER_VALUE
, 0},
8870 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8871 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8874 /* Structure describing the image type `ghostscript'. */
8876 static struct image_type gs_type
=
8886 /* Free X resources of Ghostscript image IMG which is used on frame F. */
8889 gs_clear_image (f
, img
)
8893 /* IMG->data.ptr_val may contain a recorded colormap. */
8894 xfree (img
->data
.ptr_val
);
8895 x_clear_image (f
, img
);
8899 /* Return non-zero if OBJECT is a valid Ghostscript image
8906 struct image_keyword fmt
[GS_LAST
];
8910 bcopy (gs_format
, fmt
, sizeof fmt
);
8912 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
8913 || (fmt
[GS_ASCENT
].count
8914 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
8917 /* Bounding box must be a list or vector containing 4 integers. */
8918 tem
= fmt
[GS_BOUNDING_BOX
].value
;
8921 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
8922 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
8927 else if (VECTORP (tem
))
8929 if (XVECTOR (tem
)->size
!= 4)
8931 for (i
= 0; i
< 4; ++i
)
8932 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
8942 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
8951 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
8952 struct gcpro gcpro1
, gcpro2
;
8954 double in_width
, in_height
;
8955 Lisp_Object pixel_colors
= Qnil
;
8957 /* Compute pixel size of pixmap needed from the given size in the
8958 image specification. Sizes in the specification are in pt. 1 pt
8959 = 1/72 in, xdpi and ydpi are stored in the frame's X display
8961 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
8962 in_width
= XFASTINT (pt_width
) / 72.0;
8963 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
8964 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
8965 in_height
= XFASTINT (pt_height
) / 72.0;
8966 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
8968 /* Create the pixmap. */
8970 xassert (img
->pixmap
== 0);
8971 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
8972 img
->width
, img
->height
,
8973 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
8978 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
8982 /* Call the loader to fill the pixmap. It returns a process object
8983 if successful. We do not record_unwind_protect here because
8984 other places in redisplay like calling window scroll functions
8985 don't either. Let the Lisp loader use `unwind-protect' instead. */
8986 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
8988 sprintf (buffer
, "%lu %lu",
8989 (unsigned long) FRAME_X_WINDOW (f
),
8990 (unsigned long) img
->pixmap
);
8991 window_and_pixmap_id
= build_string (buffer
);
8993 sprintf (buffer
, "%lu %lu",
8994 FRAME_FOREGROUND_PIXEL (f
),
8995 FRAME_BACKGROUND_PIXEL (f
));
8996 pixel_colors
= build_string (buffer
);
8998 XSETFRAME (frame
, f
);
8999 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9001 loader
= intern ("gs-load-image");
9003 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9004 make_number (img
->width
),
9005 make_number (img
->height
),
9006 window_and_pixmap_id
,
9009 return PROCESSP (img
->data
.lisp_val
);
9013 /* Kill the Ghostscript process that was started to fill PIXMAP on
9014 frame F. Called from XTread_socket when receiving an event
9015 telling Emacs that Ghostscript has finished drawing. */
9018 x_kill_gs_process (pixmap
, f
)
9022 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9026 /* Find the image containing PIXMAP. */
9027 for (i
= 0; i
< c
->used
; ++i
)
9028 if (c
->images
[i
]->pixmap
== pixmap
)
9031 /* Kill the GS process. We should have found PIXMAP in the image
9032 cache and its image should contain a process object. */
9033 xassert (i
< c
->used
);
9035 xassert (PROCESSP (img
->data
.lisp_val
));
9036 Fkill_process (img
->data
.lisp_val
, Qnil
);
9037 img
->data
.lisp_val
= Qnil
;
9039 /* On displays with a mutable colormap, figure out the colors
9040 allocated for the image by looking at the pixels of an XImage for
9042 class = FRAME_X_VISUAL (f
)->class;
9043 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9049 /* Try to get an XImage for img->pixmep. */
9050 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9051 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9056 /* Initialize the color table. */
9057 init_color_table ();
9059 /* For each pixel of the image, look its color up in the
9060 color table. After having done so, the color table will
9061 contain an entry for each color used by the image. */
9062 for (y
= 0; y
< img
->height
; ++y
)
9063 for (x
= 0; x
< img
->width
; ++x
)
9065 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9066 lookup_pixel_color (f
, pixel
);
9069 /* Record colors in the image. Free color table and XImage. */
9070 img
->colors
= colors_in_color_table (&img
->ncolors
);
9071 free_color_table ();
9072 XDestroyImage (ximg
);
9074 #if 0 /* This doesn't seem to be the case. If we free the colors
9075 here, we get a BadAccess later in x_clear_image when
9076 freeing the colors. */
9077 /* We have allocated colors once, but Ghostscript has also
9078 allocated colors on behalf of us. So, to get the
9079 reference counts right, free them once. */
9081 x_free_colors (f
, img
->colors
, img
->ncolors
);
9085 image_error ("Cannot get X image of `%s'; colors will not be freed",
9094 /***********************************************************************
9096 ***********************************************************************/
9098 DEFUN ("x-change-window-property", Fx_change_window_property
,
9099 Sx_change_window_property
, 2, 3, 0,
9100 "Change window property PROP to VALUE on the X window of FRAME.\n\
9101 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9102 selected frame. Value is VALUE.")
9103 (prop
, value
, frame
)
9104 Lisp_Object frame
, prop
, value
;
9106 struct frame
*f
= check_x_frame (frame
);
9109 CHECK_STRING (prop
, 1);
9110 CHECK_STRING (value
, 2);
9113 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9114 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9115 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9116 XSTRING (value
)->data
, XSTRING (value
)->size
);
9118 /* Make sure the property is set when we return. */
9119 XFlush (FRAME_X_DISPLAY (f
));
9126 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9127 Sx_delete_window_property
, 1, 2, 0,
9128 "Remove window property PROP from X window of FRAME.\n\
9129 FRAME nil or omitted means use the selected frame. Value is PROP.")
9131 Lisp_Object prop
, frame
;
9133 struct frame
*f
= check_x_frame (frame
);
9136 CHECK_STRING (prop
, 1);
9138 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9139 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9141 /* Make sure the property is removed when we return. */
9142 XFlush (FRAME_X_DISPLAY (f
));
9149 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9151 "Value is the value of window property PROP on FRAME.\n\
9152 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9153 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9156 Lisp_Object prop
, frame
;
9158 struct frame
*f
= check_x_frame (frame
);
9161 Lisp_Object prop_value
= Qnil
;
9162 char *tmp_data
= NULL
;
9165 unsigned long actual_size
, bytes_remaining
;
9167 CHECK_STRING (prop
, 1);
9169 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9170 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9171 prop_atom
, 0, 0, False
, XA_STRING
,
9172 &actual_type
, &actual_format
, &actual_size
,
9173 &bytes_remaining
, (unsigned char **) &tmp_data
);
9176 int size
= bytes_remaining
;
9181 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9182 prop_atom
, 0, bytes_remaining
,
9184 &actual_type
, &actual_format
,
9185 &actual_size
, &bytes_remaining
,
9186 (unsigned char **) &tmp_data
);
9188 prop_value
= make_string (tmp_data
, size
);
9199 /***********************************************************************
9201 ***********************************************************************/
9203 /* If non-null, an asynchronous timer that, when it expires, displays
9204 a busy cursor on all frames. */
9206 static struct atimer
*busy_cursor_atimer
;
9208 /* Non-zero means a busy cursor is currently shown. */
9210 static int busy_cursor_shown_p
;
9212 /* Number of seconds to wait before displaying a busy cursor. */
9214 static Lisp_Object Vbusy_cursor_delay
;
9216 /* Default number of seconds to wait before displaying a busy
9219 #define DEFAULT_BUSY_CURSOR_DELAY 1
9221 /* Function prototypes. */
9223 static void show_busy_cursor
P_ ((struct atimer
*));
9224 static void hide_busy_cursor
P_ ((void));
9227 /* Cancel a currently active busy-cursor timer, and start a new one. */
9230 start_busy_cursor ()
9233 int secs
, usecs
= 0;
9235 cancel_busy_cursor ();
9237 if (INTEGERP (Vbusy_cursor_delay
)
9238 && XINT (Vbusy_cursor_delay
) > 0)
9239 secs
= XFASTINT (Vbusy_cursor_delay
);
9240 else if (FLOATP (Vbusy_cursor_delay
)
9241 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
9244 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
9245 secs
= XFASTINT (tem
);
9246 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
9249 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
9251 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
9252 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
9253 show_busy_cursor
, NULL
);
9257 /* Cancel the busy cursor timer if active, hide a busy cursor if
9261 cancel_busy_cursor ()
9263 if (busy_cursor_atimer
)
9265 cancel_atimer (busy_cursor_atimer
);
9266 busy_cursor_atimer
= NULL
;
9269 if (busy_cursor_shown_p
)
9270 hide_busy_cursor ();
9274 /* Timer function of busy_cursor_atimer. TIMER is equal to
9277 Display a busy cursor on all frames by mapping the frames'
9278 busy_window. Set the busy_p flag in the frames' output_data.x
9279 structure to indicate that a busy cursor is shown on the
9283 show_busy_cursor (timer
)
9284 struct atimer
*timer
;
9286 /* The timer implementation will cancel this timer automatically
9287 after this function has run. Set busy_cursor_atimer to null
9288 so that we know the timer doesn't have to be canceled. */
9289 busy_cursor_atimer
= NULL
;
9291 if (!busy_cursor_shown_p
)
9293 Lisp_Object rest
, frame
;
9297 FOR_EACH_FRAME (rest
, frame
)
9298 if (FRAME_X_P (XFRAME (frame
)))
9300 struct frame
*f
= XFRAME (frame
);
9302 f
->output_data
.x
->busy_p
= 1;
9304 if (!f
->output_data
.x
->busy_window
)
9306 unsigned long mask
= CWCursor
;
9307 XSetWindowAttributes attrs
;
9309 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9311 f
->output_data
.x
->busy_window
9312 = XCreateWindow (FRAME_X_DISPLAY (f
),
9313 FRAME_OUTER_WINDOW (f
),
9314 0, 0, 32000, 32000, 0, 0,
9320 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9321 XFlush (FRAME_X_DISPLAY (f
));
9324 busy_cursor_shown_p
= 1;
9330 /* Hide the busy cursor on all frames, if it is currently shown. */
9335 if (busy_cursor_shown_p
)
9337 Lisp_Object rest
, frame
;
9340 FOR_EACH_FRAME (rest
, frame
)
9342 struct frame
*f
= XFRAME (frame
);
9345 /* Watch out for newly created frames. */
9346 && f
->output_data
.x
->busy_window
)
9348 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9349 /* Sync here because XTread_socket looks at the busy_p flag
9350 that is reset to zero below. */
9351 XSync (FRAME_X_DISPLAY (f
), False
);
9352 f
->output_data
.x
->busy_p
= 0;
9356 busy_cursor_shown_p
= 0;
9363 /***********************************************************************
9365 ***********************************************************************/
9367 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9370 /* The frame of a currently visible tooltip, or null. */
9372 struct frame
*tip_frame
;
9374 /* If non-nil, a timer started that hides the last tooltip when it
9377 Lisp_Object tip_timer
;
9380 /* Create a frame for a tooltip on the display described by DPYINFO.
9381 PARMS is a list of frame parameters. Value is the frame. */
9384 x_create_tip_frame (dpyinfo
, parms
)
9385 struct x_display_info
*dpyinfo
;
9389 Lisp_Object frame
, tem
;
9391 long window_prompting
= 0;
9393 int count
= specpdl_ptr
- specpdl
;
9394 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9399 /* Use this general default value to start with until we know if
9400 this frame has a specified name. */
9401 Vx_resource_name
= Vinvocation_name
;
9404 kb
= dpyinfo
->kboard
;
9406 kb
= &the_only_kboard
;
9409 /* Get the name of the frame to use for resource lookup. */
9410 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9412 && !EQ (name
, Qunbound
)
9414 error ("Invalid frame name--not a string or nil");
9415 Vx_resource_name
= name
;
9418 GCPRO3 (parms
, name
, frame
);
9419 tip_frame
= f
= make_frame (1);
9420 XSETFRAME (frame
, f
);
9421 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9423 f
->output_method
= output_x_window
;
9424 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9425 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9426 f
->output_data
.x
->icon_bitmap
= -1;
9427 f
->output_data
.x
->fontset
= -1;
9428 f
->icon_name
= Qnil
;
9429 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9431 FRAME_KBOARD (f
) = kb
;
9433 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9434 f
->output_data
.x
->explicit_parent
= 0;
9436 /* Set the name; the functions to which we pass f expect the name to
9438 if (EQ (name
, Qunbound
) || NILP (name
))
9440 f
->name
= build_string (dpyinfo
->x_id_name
);
9441 f
->explicit_name
= 0;
9446 f
->explicit_name
= 1;
9447 /* use the frame's title when getting resources for this frame. */
9448 specbind (Qx_resource_name
, name
);
9451 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9452 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9453 fs_register_fontset (f
, XCAR (tem
));
9455 /* Extract the window parameters from the supplied values
9456 that are needed to determine window geometry. */
9460 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9463 /* First, try whatever font the caller has specified. */
9466 tem
= Fquery_fontset (font
, Qnil
);
9468 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9470 font
= x_new_font (f
, XSTRING (font
)->data
);
9473 /* Try out a font which we hope has bold and italic variations. */
9474 if (!STRINGP (font
))
9475 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9476 if (!STRINGP (font
))
9477 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9478 if (! STRINGP (font
))
9479 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9480 if (! STRINGP (font
))
9481 /* This was formerly the first thing tried, but it finds too many fonts
9482 and takes too long. */
9483 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9484 /* If those didn't work, look for something which will at least work. */
9485 if (! STRINGP (font
))
9486 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9488 if (! STRINGP (font
))
9489 font
= build_string ("fixed");
9491 x_default_parameter (f
, parms
, Qfont
, font
,
9492 "font", "Font", RES_TYPE_STRING
);
9495 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9496 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9498 /* This defaults to 2 in order to match xterm. We recognize either
9499 internalBorderWidth or internalBorder (which is what xterm calls
9501 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9505 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9506 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9507 if (! EQ (value
, Qunbound
))
9508 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9512 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9513 "internalBorderWidth", "internalBorderWidth",
9516 /* Also do the stuff which must be set before the window exists. */
9517 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9518 "foreground", "Foreground", RES_TYPE_STRING
);
9519 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9520 "background", "Background", RES_TYPE_STRING
);
9521 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9522 "pointerColor", "Foreground", RES_TYPE_STRING
);
9523 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9524 "cursorColor", "Foreground", RES_TYPE_STRING
);
9525 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9526 "borderColor", "BorderColor", RES_TYPE_STRING
);
9528 /* Init faces before x_default_parameter is called for scroll-bar
9529 parameters because that function calls x_set_scroll_bar_width,
9530 which calls change_frame_size, which calls Fset_window_buffer,
9531 which runs hooks, which call Fvertical_motion. At the end, we
9532 end up in init_iterator with a null face cache, which should not
9534 init_frame_faces (f
);
9536 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9537 window_prompting
= x_figure_window_size (f
, parms
);
9539 if (window_prompting
& XNegative
)
9541 if (window_prompting
& YNegative
)
9542 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9544 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9548 if (window_prompting
& YNegative
)
9549 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9551 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9554 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9556 XSetWindowAttributes attrs
;
9560 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9561 /* Window managers look at the override-redirect flag to determine
9562 whether or net to give windows a decoration (Xlib spec, chapter
9564 attrs
.override_redirect
= True
;
9565 attrs
.save_under
= True
;
9566 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9567 /* Arrange for getting MapNotify and UnmapNotify events. */
9568 attrs
.event_mask
= StructureNotifyMask
;
9570 = FRAME_X_WINDOW (f
)
9571 = XCreateWindow (FRAME_X_DISPLAY (f
),
9572 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9573 /* x, y, width, height */
9577 CopyFromParent
, InputOutput
, CopyFromParent
,
9584 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9585 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9586 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9587 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9588 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9589 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9591 /* Dimensions, especially f->height, must be done via change_frame_size.
9592 Change will not be effected unless different from the current
9597 SET_FRAME_WIDTH (f
, 0);
9598 change_frame_size (f
, height
, width
, 1, 0, 0);
9604 /* It is now ok to make the frame official even if we get an error
9605 below. And the frame needs to be on Vframe_list or making it
9606 visible won't work. */
9607 Vframe_list
= Fcons (frame
, Vframe_list
);
9609 /* Now that the frame is official, it counts as a reference to
9611 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9613 return unbind_to (count
, frame
);
9617 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9618 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9619 A tooltip window is a small X window displaying STRING at\n\
9620 the current mouse position.\n\
9621 FRAME nil or omitted means use the selected frame.\n\
9622 PARMS is an optional list of frame parameters which can be\n\
9623 used to change the tooltip's appearance.\n\
9624 Automatically hide the tooltip after TIMEOUT seconds.\n\
9625 TIMEOUT nil means use the default timeout of 5 seconds.")
9626 (string
, frame
, parms
, timeout
)
9627 Lisp_Object string
, frame
, parms
, timeout
;
9633 struct buffer
*old_buffer
;
9634 struct text_pos pos
;
9635 int i
, width
, height
;
9636 int root_x
, root_y
, win_x
, win_y
;
9638 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
9639 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9640 int count
= specpdl_ptr
- specpdl
;
9642 specbind (Qinhibit_redisplay
, Qt
);
9644 GCPRO4 (string
, parms
, frame
, timeout
);
9646 CHECK_STRING (string
, 0);
9647 f
= check_x_frame (frame
);
9649 timeout
= make_number (5);
9651 CHECK_NATNUM (timeout
, 2);
9653 /* Hide a previous tip, if any. */
9656 /* Add default values to frame parameters. */
9657 if (NILP (Fassq (Qname
, parms
)))
9658 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9659 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9660 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9661 if (NILP (Fassq (Qborder_width
, parms
)))
9662 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9663 if (NILP (Fassq (Qborder_color
, parms
)))
9664 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9665 if (NILP (Fassq (Qbackground_color
, parms
)))
9666 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9669 /* Create a frame for the tooltip, and record it in the global
9670 variable tip_frame. */
9671 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9672 tip_frame
= f
= XFRAME (frame
);
9674 /* Set up the frame's root window. Currently we use a size of 80
9675 columns x 40 lines. If someone wants to show a larger tip, he
9676 will loose. I don't think this is a realistic case. */
9677 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9678 w
->left
= w
->top
= make_number (0);
9682 w
->pseudo_window_p
= 1;
9684 /* Display the tooltip text in a temporary buffer. */
9685 buffer
= Fget_buffer_create (build_string (" *tip*"));
9686 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9687 old_buffer
= current_buffer
;
9688 set_buffer_internal_1 (XBUFFER (buffer
));
9690 Finsert (make_number (1), &string
);
9691 clear_glyph_matrix (w
->desired_matrix
);
9692 clear_glyph_matrix (w
->current_matrix
);
9693 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9694 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9696 /* Compute width and height of the tooltip. */
9698 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9700 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9704 /* Stop at the first empty row at the end. */
9705 if (!row
->enabled_p
|| !row
->displays_text_p
)
9708 /* Let the row go over the full width of the frame. */
9709 row
->full_width_p
= 1;
9711 /* There's a glyph at the end of rows that is use to place
9712 the cursor there. Don't include the width of this glyph. */
9713 if (row
->used
[TEXT_AREA
])
9715 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9716 row_width
= row
->pixel_width
- last
->pixel_width
;
9719 row_width
= row
->pixel_width
;
9721 height
+= row
->height
;
9722 width
= max (width
, row_width
);
9725 /* Add the frame's internal border to the width and height the X
9726 window should have. */
9727 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9728 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9730 /* Move the tooltip window where the mouse pointer is. Resize and
9733 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9734 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9735 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9736 root_x
+ 5, root_y
- height
- 5, width
, height
);
9737 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9740 /* Draw into the window. */
9741 w
->must_be_updated_p
= 1;
9742 update_single_window (w
, 1);
9744 /* Restore original current buffer. */
9745 set_buffer_internal_1 (old_buffer
);
9746 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9748 /* Let the tip disappear after timeout seconds. */
9749 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9750 intern ("x-hide-tip"));
9753 return unbind_to (count
, Qnil
);
9757 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9758 "Hide the current tooltip window, if there is any.\n\
9759 Value is t is tooltip was open, nil otherwise.")
9762 int count
= specpdl_ptr
- specpdl
;
9765 specbind (Qinhibit_redisplay
, Qt
);
9767 if (!NILP (tip_timer
))
9769 call1 (intern ("cancel-timer"), tip_timer
);
9777 XSETFRAME (frame
, tip_frame
);
9778 Fdelete_frame (frame
, Qt
);
9783 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9788 /***********************************************************************
9789 File selection dialog
9790 ***********************************************************************/
9794 /* Callback for "OK" and "Cancel" on file selection dialog. */
9797 file_dialog_cb (widget
, client_data
, call_data
)
9799 XtPointer call_data
, client_data
;
9801 int *result
= (int *) client_data
;
9802 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9803 *result
= cb
->reason
;
9807 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9808 "Read file name, prompting with PROMPT in directory DIR.\n\
9809 Use a file selection dialog.\n\
9810 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9811 specified. Don't let the user enter a file name in the file\n\
9812 selection dialog's entry field, if MUSTMATCH is non-nil.")
9813 (prompt
, dir
, default_filename
, mustmatch
)
9814 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9817 struct frame
*f
= SELECTED_FRAME ();
9818 Lisp_Object file
= Qnil
;
9819 Widget dialog
, text
, list
, help
;
9822 extern XtAppContext Xt_app_con
;
9824 XmString dir_xmstring
, pattern_xmstring
;
9825 int popup_activated_flag
;
9826 int count
= specpdl_ptr
- specpdl
;
9827 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9829 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9830 CHECK_STRING (prompt
, 0);
9831 CHECK_STRING (dir
, 1);
9833 /* Prevent redisplay. */
9834 specbind (Qinhibit_redisplay
, Qt
);
9838 /* Create the dialog with PROMPT as title, using DIR as initial
9839 directory and using "*" as pattern. */
9840 dir
= Fexpand_file_name (dir
, Qnil
);
9841 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9842 pattern_xmstring
= XmStringCreateLocalized ("*");
9844 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9845 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9846 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9847 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9848 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9849 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9851 XmStringFree (dir_xmstring
);
9852 XmStringFree (pattern_xmstring
);
9854 /* Add callbacks for OK and Cancel. */
9855 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9856 (XtPointer
) &result
);
9857 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9858 (XtPointer
) &result
);
9860 /* Disable the help button since we can't display help. */
9861 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9862 XtSetSensitive (help
, False
);
9864 /* Mark OK button as default. */
9865 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
9866 XmNshowAsDefault
, True
, NULL
);
9868 /* If MUSTMATCH is non-nil, disable the file entry field of the
9869 dialog, so that the user must select a file from the files list
9870 box. We can't remove it because we wouldn't have a way to get at
9871 the result file name, then. */
9872 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
9873 if (!NILP (mustmatch
))
9876 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
9877 XtSetSensitive (text
, False
);
9878 XtSetSensitive (label
, False
);
9881 /* Manage the dialog, so that list boxes get filled. */
9882 XtManageChild (dialog
);
9884 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
9885 must include the path for this to work. */
9886 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
9887 if (STRINGP (default_filename
))
9889 XmString default_xmstring
;
9893 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
9895 if (!XmListItemExists (list
, default_xmstring
))
9897 /* Add a new item if DEFAULT_FILENAME is not in the list. */
9898 XmListAddItem (list
, default_xmstring
, 0);
9902 item_pos
= XmListItemPos (list
, default_xmstring
);
9903 XmStringFree (default_xmstring
);
9905 /* Select the item and scroll it into view. */
9906 XmListSelectPos (list
, item_pos
, True
);
9907 XmListSetPos (list
, item_pos
);
9910 /* Process all events until the user presses Cancel or OK. */
9911 for (result
= 0; result
== 0;)
9914 Widget widget
, parent
;
9916 XtAppNextEvent (Xt_app_con
, &event
);
9918 /* See if the receiver of the event is one of the widgets of
9919 the file selection dialog. If so, dispatch it. If not,
9921 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
9923 while (parent
&& parent
!= dialog
)
9924 parent
= XtParent (parent
);
9926 if (parent
== dialog
9927 || (event
.type
== Expose
9928 && !process_expose_from_menu (event
)))
9929 XtDispatchEvent (&event
);
9932 /* Get the result. */
9933 if (result
== XmCR_OK
)
9938 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
9939 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
9940 XmStringFree (text
);
9941 file
= build_string (data
);
9948 XtUnmanageChild (dialog
);
9949 XtDestroyWidget (dialog
);
9953 /* Make "Cancel" equivalent to C-g. */
9955 Fsignal (Qquit
, Qnil
);
9957 return unbind_to (count
, file
);
9960 #endif /* USE_MOTIF */
9963 /***********************************************************************
9965 ***********************************************************************/
9969 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
9970 "Value is non-nil if SPEC is a valid image specification.")
9974 return valid_image_p (spec
) ? Qt
: Qnil
;
9978 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
9984 if (valid_image_p (spec
))
9985 id
= lookup_image (SELECTED_FRAME (), spec
);
9988 return make_number (id
);
9991 #endif /* GLYPH_DEBUG != 0 */
9995 /***********************************************************************
9997 ***********************************************************************/
10002 /* This is zero if not using X windows. */
10005 /* The section below is built by the lisp expression at the top of the file,
10006 just above where these variables are declared. */
10007 /*&&& init symbols here &&&*/
10008 Qauto_raise
= intern ("auto-raise");
10009 staticpro (&Qauto_raise
);
10010 Qauto_lower
= intern ("auto-lower");
10011 staticpro (&Qauto_lower
);
10012 Qbar
= intern ("bar");
10014 Qborder_color
= intern ("border-color");
10015 staticpro (&Qborder_color
);
10016 Qborder_width
= intern ("border-width");
10017 staticpro (&Qborder_width
);
10018 Qbox
= intern ("box");
10020 Qcursor_color
= intern ("cursor-color");
10021 staticpro (&Qcursor_color
);
10022 Qcursor_type
= intern ("cursor-type");
10023 staticpro (&Qcursor_type
);
10024 Qgeometry
= intern ("geometry");
10025 staticpro (&Qgeometry
);
10026 Qicon_left
= intern ("icon-left");
10027 staticpro (&Qicon_left
);
10028 Qicon_top
= intern ("icon-top");
10029 staticpro (&Qicon_top
);
10030 Qicon_type
= intern ("icon-type");
10031 staticpro (&Qicon_type
);
10032 Qicon_name
= intern ("icon-name");
10033 staticpro (&Qicon_name
);
10034 Qinternal_border_width
= intern ("internal-border-width");
10035 staticpro (&Qinternal_border_width
);
10036 Qleft
= intern ("left");
10037 staticpro (&Qleft
);
10038 Qright
= intern ("right");
10039 staticpro (&Qright
);
10040 Qmouse_color
= intern ("mouse-color");
10041 staticpro (&Qmouse_color
);
10042 Qnone
= intern ("none");
10043 staticpro (&Qnone
);
10044 Qparent_id
= intern ("parent-id");
10045 staticpro (&Qparent_id
);
10046 Qscroll_bar_width
= intern ("scroll-bar-width");
10047 staticpro (&Qscroll_bar_width
);
10048 Qsuppress_icon
= intern ("suppress-icon");
10049 staticpro (&Qsuppress_icon
);
10050 Qundefined_color
= intern ("undefined-color");
10051 staticpro (&Qundefined_color
);
10052 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10053 staticpro (&Qvertical_scroll_bars
);
10054 Qvisibility
= intern ("visibility");
10055 staticpro (&Qvisibility
);
10056 Qwindow_id
= intern ("window-id");
10057 staticpro (&Qwindow_id
);
10058 Qouter_window_id
= intern ("outer-window-id");
10059 staticpro (&Qouter_window_id
);
10060 Qx_frame_parameter
= intern ("x-frame-parameter");
10061 staticpro (&Qx_frame_parameter
);
10062 Qx_resource_name
= intern ("x-resource-name");
10063 staticpro (&Qx_resource_name
);
10064 Quser_position
= intern ("user-position");
10065 staticpro (&Quser_position
);
10066 Quser_size
= intern ("user-size");
10067 staticpro (&Quser_size
);
10068 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10069 staticpro (&Qscroll_bar_foreground
);
10070 Qscroll_bar_background
= intern ("scroll-bar-background");
10071 staticpro (&Qscroll_bar_background
);
10072 Qscreen_gamma
= intern ("screen-gamma");
10073 staticpro (&Qscreen_gamma
);
10074 /* This is the end of symbol initialization. */
10076 /* Text property `display' should be nonsticky by default. */
10077 Vtext_property_default_nonsticky
10078 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10081 Qlaplace
= intern ("laplace");
10082 staticpro (&Qlaplace
);
10084 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10085 staticpro (&Qface_set_after_frame_default
);
10087 Fput (Qundefined_color
, Qerror_conditions
,
10088 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10089 Fput (Qundefined_color
, Qerror_message
,
10090 build_string ("Undefined color"));
10092 init_x_parm_symbols ();
10094 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10095 "List of directories to search for bitmap files for X.");
10096 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10098 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10099 "The shape of the pointer when over text.\n\
10100 Changing the value does not affect existing frames\n\
10101 unless you set the mouse color.");
10102 Vx_pointer_shape
= Qnil
;
10104 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10105 "The name Emacs uses to look up X resources.\n\
10106 `x-get-resource' uses this as the first component of the instance name\n\
10107 when requesting resource values.\n\
10108 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10109 was invoked, or to the value specified with the `-name' or `-rn'\n\
10110 switches, if present.\n\
10112 It may be useful to bind this variable locally around a call\n\
10113 to `x-get-resource'. See also the variable `x-resource-class'.");
10114 Vx_resource_name
= Qnil
;
10116 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10117 "The class Emacs uses to look up X resources.\n\
10118 `x-get-resource' uses this as the first component of the instance class\n\
10119 when requesting resource values.\n\
10120 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10122 Setting this variable permanently is not a reasonable thing to do,\n\
10123 but binding this variable locally around a call to `x-get-resource'\n\
10124 is a reasonable practice. See also the variable `x-resource-name'.");
10125 Vx_resource_class
= build_string (EMACS_CLASS
);
10127 #if 0 /* This doesn't really do anything. */
10128 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10129 "The shape of the pointer when not over text.\n\
10130 This variable takes effect when you create a new frame\n\
10131 or when you set the mouse color.");
10133 Vx_nontext_pointer_shape
= Qnil
;
10135 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10136 "The shape of the pointer when Emacs is busy.\n\
10137 This variable takes effect when you create a new frame\n\
10138 or when you set the mouse color.");
10139 Vx_busy_pointer_shape
= Qnil
;
10141 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10142 "Non-zero means Emacs displays a busy cursor on window systems.");
10143 display_busy_cursor_p
= 1;
10145 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10146 "*Seconds to wait before displaying a busy-cursor.\n\
10147 Value must be an integer or float.");
10148 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10150 #if 0 /* This doesn't really do anything. */
10151 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10152 "The shape of the pointer when over the mode line.\n\
10153 This variable takes effect when you create a new frame\n\
10154 or when you set the mouse color.");
10156 Vx_mode_pointer_shape
= Qnil
;
10158 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10159 &Vx_sensitive_text_pointer_shape
,
10160 "The shape of the pointer when over mouse-sensitive text.\n\
10161 This variable takes effect when you create a new frame\n\
10162 or when you set the mouse color.");
10163 Vx_sensitive_text_pointer_shape
= Qnil
;
10165 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10166 "A string indicating the foreground color of the cursor box.");
10167 Vx_cursor_fore_pixel
= Qnil
;
10169 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10170 "Non-nil if no X window manager is in use.\n\
10171 Emacs doesn't try to figure this out; this is always nil\n\
10172 unless you set it to something else.");
10173 /* We don't have any way to find this out, so set it to nil
10174 and maybe the user would like to set it to t. */
10175 Vx_no_window_manager
= Qnil
;
10177 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10178 &Vx_pixel_size_width_font_regexp
,
10179 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10181 Since Emacs gets width of a font matching with this regexp from\n\
10182 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10183 such a font. This is especially effective for such large fonts as\n\
10184 Chinese, Japanese, and Korean.");
10185 Vx_pixel_size_width_font_regexp
= Qnil
;
10187 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10188 "Time after which cached images are removed from the cache.\n\
10189 When an image has not been displayed this many seconds, remove it\n\
10190 from the image cache. Value must be an integer or nil with nil\n\
10191 meaning don't clear the cache.");
10192 Vimage_cache_eviction_delay
= make_number (30 * 60);
10194 DEFVAR_LISP ("image-types", &Vimage_types
,
10195 "List of supported image types.\n\
10196 Each element of the list is a symbol for a supported image type.");
10197 Vimage_types
= Qnil
;
10199 #ifdef USE_X_TOOLKIT
10200 Fprovide (intern ("x-toolkit"));
10203 Fprovide (intern ("motif"));
10206 defsubr (&Sx_get_resource
);
10208 /* X window properties. */
10209 defsubr (&Sx_change_window_property
);
10210 defsubr (&Sx_delete_window_property
);
10211 defsubr (&Sx_window_property
);
10213 defsubr (&Sxw_display_color_p
);
10214 defsubr (&Sx_display_grayscale_p
);
10215 defsubr (&Sxw_color_defined_p
);
10216 defsubr (&Sxw_color_values
);
10217 defsubr (&Sx_server_max_request_size
);
10218 defsubr (&Sx_server_vendor
);
10219 defsubr (&Sx_server_version
);
10220 defsubr (&Sx_display_pixel_width
);
10221 defsubr (&Sx_display_pixel_height
);
10222 defsubr (&Sx_display_mm_width
);
10223 defsubr (&Sx_display_mm_height
);
10224 defsubr (&Sx_display_screens
);
10225 defsubr (&Sx_display_planes
);
10226 defsubr (&Sx_display_color_cells
);
10227 defsubr (&Sx_display_visual_class
);
10228 defsubr (&Sx_display_backing_store
);
10229 defsubr (&Sx_display_save_under
);
10230 defsubr (&Sx_parse_geometry
);
10231 defsubr (&Sx_create_frame
);
10232 defsubr (&Sx_open_connection
);
10233 defsubr (&Sx_close_connection
);
10234 defsubr (&Sx_display_list
);
10235 defsubr (&Sx_synchronize
);
10236 defsubr (&Sx_focus_frame
);
10238 /* Setting callback functions for fontset handler. */
10239 get_font_info_func
= x_get_font_info
;
10241 #if 0 /* This function pointer doesn't seem to be used anywhere.
10242 And the pointer assigned has the wrong type, anyway. */
10243 list_fonts_func
= x_list_fonts
;
10246 load_font_func
= x_load_font
;
10247 find_ccl_program_func
= x_find_ccl_program
;
10248 query_font_func
= x_query_font
;
10249 set_frame_fontset_func
= x_set_font
;
10250 check_window_system_func
= check_x
;
10253 Qxbm
= intern ("xbm");
10255 QCtype
= intern (":type");
10256 staticpro (&QCtype
);
10257 QCalgorithm
= intern (":algorithm");
10258 staticpro (&QCalgorithm
);
10259 QCheuristic_mask
= intern (":heuristic-mask");
10260 staticpro (&QCheuristic_mask
);
10261 QCcolor_symbols
= intern (":color-symbols");
10262 staticpro (&QCcolor_symbols
);
10263 QCascent
= intern (":ascent");
10264 staticpro (&QCascent
);
10265 QCmargin
= intern (":margin");
10266 staticpro (&QCmargin
);
10267 QCrelief
= intern (":relief");
10268 staticpro (&QCrelief
);
10269 Qpostscript
= intern ("postscript");
10270 staticpro (&Qpostscript
);
10271 QCloader
= intern (":loader");
10272 staticpro (&QCloader
);
10273 QCbounding_box
= intern (":bounding-box");
10274 staticpro (&QCbounding_box
);
10275 QCpt_width
= intern (":pt-width");
10276 staticpro (&QCpt_width
);
10277 QCpt_height
= intern (":pt-height");
10278 staticpro (&QCpt_height
);
10279 QCindex
= intern (":index");
10280 staticpro (&QCindex
);
10281 Qpbm
= intern ("pbm");
10285 Qxpm
= intern ("xpm");
10290 Qjpeg
= intern ("jpeg");
10291 staticpro (&Qjpeg
);
10295 Qtiff
= intern ("tiff");
10296 staticpro (&Qtiff
);
10300 Qgif
= intern ("gif");
10305 Qpng
= intern ("png");
10309 defsubr (&Sclear_image_cache
);
10312 defsubr (&Simagep
);
10313 defsubr (&Slookup_image
);
10316 busy_cursor_atimer
= NULL
;
10317 busy_cursor_shown_p
= 0;
10319 defsubr (&Sx_show_tip
);
10320 defsubr (&Sx_hide_tip
);
10321 staticpro (&tip_timer
);
10325 defsubr (&Sx_file_dialog
);
10333 image_types
= NULL
;
10334 Vimage_types
= Qnil
;
10336 define_image_type (&xbm_type
);
10337 define_image_type (&gs_type
);
10338 define_image_type (&pbm_type
);
10341 define_image_type (&xpm_type
);
10345 define_image_type (&jpeg_type
);
10349 define_image_type (&tiff_type
);
10353 define_image_type (&gif_type
);
10357 define_image_type (&png_type
);
10361 #endif /* HAVE_X_WINDOWS */