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
, Qline_spacing
, Qcenter
;
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 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
755 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
760 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
768 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
770 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
775 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
777 static struct x_frame_parm_table x_frame_parms
[] =
779 "auto-raise", x_set_autoraise
,
780 "auto-lower", x_set_autolower
,
781 "background-color", x_set_background_color
,
782 "border-color", x_set_border_color
,
783 "border-width", x_set_border_width
,
784 "cursor-color", x_set_cursor_color
,
785 "cursor-type", x_set_cursor_type
,
787 "foreground-color", x_set_foreground_color
,
788 "icon-name", x_set_icon_name
,
789 "icon-type", x_set_icon_type
,
790 "internal-border-width", x_set_internal_border_width
,
791 "menu-bar-lines", x_set_menu_bar_lines
,
792 "mouse-color", x_set_mouse_color
,
793 "name", x_explicitly_set_name
,
794 "scroll-bar-width", x_set_scroll_bar_width
,
795 "title", x_set_title
,
796 "unsplittable", x_set_unsplittable
,
797 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
798 "visibility", x_set_visibility
,
799 "tool-bar-lines", x_set_tool_bar_lines
,
800 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
801 "scroll-bar-background", x_set_scroll_bar_background
,
802 "screen-gamma", x_set_screen_gamma
,
803 "line-spacing", x_set_line_spacing
806 /* Attach the `x-frame-parameter' properties to
807 the Lisp symbol names of parameters relevant to X. */
810 init_x_parm_symbols ()
814 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
815 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
819 /* Change the parameters of frame F as specified by ALIST.
820 If a parameter is not specially recognized, do nothing;
821 otherwise call the `x_set_...' function for that parameter. */
824 x_set_frame_parameters (f
, alist
)
830 /* If both of these parameters are present, it's more efficient to
831 set them both at once. So we wait until we've looked at the
832 entire list before we set them. */
836 Lisp_Object left
, top
;
838 /* Same with these. */
839 Lisp_Object icon_left
, icon_top
;
841 /* Record in these vectors all the parms specified. */
845 int left_no_change
= 0, top_no_change
= 0;
846 int icon_left_no_change
= 0, icon_top_no_change
= 0;
848 struct gcpro gcpro1
, gcpro2
;
851 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
854 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
855 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
857 /* Extract parm names and values into those vectors. */
860 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
865 parms
[i
] = Fcar (elt
);
866 values
[i
] = Fcdr (elt
);
869 /* TAIL and ALIST are not used again below here. */
872 GCPRO2 (*parms
, *values
);
876 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
877 because their values appear in VALUES and strings are not valid. */
878 top
= left
= Qunbound
;
879 icon_left
= icon_top
= Qunbound
;
881 /* Provide default values for HEIGHT and WIDTH. */
882 if (FRAME_NEW_WIDTH (f
))
883 width
= FRAME_NEW_WIDTH (f
);
885 width
= FRAME_WIDTH (f
);
887 if (FRAME_NEW_HEIGHT (f
))
888 height
= FRAME_NEW_HEIGHT (f
);
890 height
= FRAME_HEIGHT (f
);
892 /* Process foreground_color and background_color before anything else.
893 They are independent of other properties, but other properties (e.g.,
894 cursor_color) are dependent upon them. */
895 for (p
= 0; p
< i
; p
++)
897 Lisp_Object prop
, val
;
901 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
903 register Lisp_Object param_index
, old_value
;
905 param_index
= Fget (prop
, Qx_frame_parameter
);
906 old_value
= get_frame_param (f
, prop
);
907 store_frame_param (f
, prop
, val
);
908 if (NATNUMP (param_index
)
909 && (XFASTINT (param_index
)
910 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
911 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
915 /* Now process them in reverse of specified order. */
916 for (i
--; i
>= 0; i
--)
918 Lisp_Object prop
, val
;
923 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
924 width
= XFASTINT (val
);
925 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
926 height
= XFASTINT (val
);
927 else if (EQ (prop
, Qtop
))
929 else if (EQ (prop
, Qleft
))
931 else if (EQ (prop
, Qicon_top
))
933 else if (EQ (prop
, Qicon_left
))
935 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
936 /* Processed above. */
940 register Lisp_Object param_index
, old_value
;
942 param_index
= Fget (prop
, Qx_frame_parameter
);
943 old_value
= get_frame_param (f
, prop
);
944 store_frame_param (f
, prop
, val
);
945 if (NATNUMP (param_index
)
946 && (XFASTINT (param_index
)
947 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
948 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
952 /* Don't die if just one of these was set. */
953 if (EQ (left
, Qunbound
))
956 if (f
->output_data
.x
->left_pos
< 0)
957 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
959 XSETINT (left
, f
->output_data
.x
->left_pos
);
961 if (EQ (top
, Qunbound
))
964 if (f
->output_data
.x
->top_pos
< 0)
965 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
967 XSETINT (top
, f
->output_data
.x
->top_pos
);
970 /* If one of the icon positions was not set, preserve or default it. */
971 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
973 icon_left_no_change
= 1;
974 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
975 if (NILP (icon_left
))
976 XSETINT (icon_left
, 0);
978 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
980 icon_top_no_change
= 1;
981 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
983 XSETINT (icon_top
, 0);
986 /* Don't set these parameters unless they've been explicitly
987 specified. The window might be mapped or resized while we're in
988 this function, and we don't want to override that unless the lisp
989 code has asked for it.
991 Don't set these parameters unless they actually differ from the
992 window's current parameters; the window may not actually exist
997 check_frame_size (f
, &height
, &width
);
999 XSETFRAME (frame
, f
);
1001 if (width
!= FRAME_WIDTH (f
)
1002 || height
!= FRAME_HEIGHT (f
)
1003 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1004 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1006 if ((!NILP (left
) || !NILP (top
))
1007 && ! (left_no_change
&& top_no_change
)
1008 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1009 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1014 /* Record the signs. */
1015 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1016 if (EQ (left
, Qminus
))
1017 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1018 else if (INTEGERP (left
))
1020 leftpos
= XINT (left
);
1022 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1025 && CONSP (XCDR (left
))
1026 && INTEGERP (XCAR (XCDR (left
))))
1028 leftpos
= - XINT (XCAR (XCDR (left
)));
1029 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1031 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1032 && CONSP (XCDR (left
))
1033 && INTEGERP (XCAR (XCDR (left
))))
1035 leftpos
= XINT (XCAR (XCDR (left
)));
1038 if (EQ (top
, Qminus
))
1039 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1040 else if (INTEGERP (top
))
1042 toppos
= XINT (top
);
1044 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1047 && CONSP (XCDR (top
))
1048 && INTEGERP (XCAR (XCDR (top
))))
1050 toppos
= - XINT (XCAR (XCDR (top
)));
1051 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1053 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1054 && CONSP (XCDR (top
))
1055 && INTEGERP (XCAR (XCDR (top
))))
1057 toppos
= XINT (XCAR (XCDR (top
)));
1061 /* Store the numeric value of the position. */
1062 f
->output_data
.x
->top_pos
= toppos
;
1063 f
->output_data
.x
->left_pos
= leftpos
;
1065 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1067 /* Actually set that position, and convert to absolute. */
1068 x_set_offset (f
, leftpos
, toppos
, -1);
1071 if ((!NILP (icon_left
) || !NILP (icon_top
))
1072 && ! (icon_left_no_change
&& icon_top_no_change
))
1073 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1079 /* Store the screen positions of frame F into XPTR and YPTR.
1080 These are the positions of the containing window manager window,
1081 not Emacs's own window. */
1084 x_real_positions (f
, xptr
, yptr
)
1091 /* This is pretty gross, but seems to be the easiest way out of
1092 the problem that arises when restarting window-managers. */
1094 #ifdef USE_X_TOOLKIT
1095 Window outer
= (f
->output_data
.x
->widget
1096 ? XtWindow (f
->output_data
.x
->widget
)
1097 : FRAME_X_WINDOW (f
));
1099 Window outer
= f
->output_data
.x
->window_desc
;
1101 Window tmp_root_window
;
1102 Window
*tmp_children
;
1103 unsigned int tmp_nchildren
;
1107 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1108 Window outer_window
;
1110 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1111 &f
->output_data
.x
->parent_desc
,
1112 &tmp_children
, &tmp_nchildren
);
1113 XFree ((char *) tmp_children
);
1117 /* Find the position of the outside upper-left corner of
1118 the inner window, with respect to the outer window. */
1119 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1120 outer_window
= f
->output_data
.x
->parent_desc
;
1122 outer_window
= outer
;
1124 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1126 /* From-window, to-window. */
1128 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1130 /* From-position, to-position. */
1131 0, 0, &win_x
, &win_y
,
1136 /* It is possible for the window returned by the XQueryNotify
1137 to become invalid by the time we call XTranslateCoordinates.
1138 That can happen when you restart some window managers.
1139 If so, we get an error in XTranslateCoordinates.
1140 Detect that and try the whole thing over. */
1141 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1143 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1154 /* Insert a description of internally-recorded parameters of frame X
1155 into the parameter alist *ALISTPTR that is to be given to the user.
1156 Only parameters that are specific to the X window system
1157 and whose values are not correctly recorded in the frame's
1158 param_alist need to be considered here. */
1161 x_report_frame_params (f
, alistptr
)
1163 Lisp_Object
*alistptr
;
1168 /* Represent negative positions (off the top or left screen edge)
1169 in a way that Fmodify_frame_parameters will understand correctly. */
1170 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1171 if (f
->output_data
.x
->left_pos
>= 0)
1172 store_in_alist (alistptr
, Qleft
, tem
);
1174 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1176 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1177 if (f
->output_data
.x
->top_pos
>= 0)
1178 store_in_alist (alistptr
, Qtop
, tem
);
1180 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 store_in_alist (alistptr
, Qborder_width
,
1183 make_number (f
->output_data
.x
->border_width
));
1184 store_in_alist (alistptr
, Qinternal_border_width
,
1185 make_number (f
->output_data
.x
->internal_border_width
));
1186 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1187 store_in_alist (alistptr
, Qwindow_id
,
1188 build_string (buf
));
1189 #ifdef USE_X_TOOLKIT
1190 /* Tooltip frame may not have this widget. */
1191 if (f
->output_data
.x
->widget
)
1193 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1194 store_in_alist (alistptr
, Qouter_window_id
,
1195 build_string (buf
));
1196 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1197 FRAME_SAMPLE_VISIBILITY (f
);
1198 store_in_alist (alistptr
, Qvisibility
,
1199 (FRAME_VISIBLE_P (f
) ? Qt
1200 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1201 store_in_alist (alistptr
, Qdisplay
,
1202 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1204 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1207 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1208 store_in_alist (alistptr
, Qparent_id
, tem
);
1213 /* Gamma-correct COLOR on frame F. */
1216 gamma_correct (f
, color
)
1222 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1223 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1224 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1230 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1231 allocate the color. Value is zero if COLOR_NAME is invalid, or
1232 no color could be allocated. */
1235 x_defined_color (f
, color_name
, color
, alloc_p
)
1242 Display
*dpy
= FRAME_X_DISPLAY (f
);
1243 Colormap cmap
= FRAME_X_COLORMAP (f
);
1246 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1247 if (success_p
&& alloc_p
)
1248 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1255 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1256 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1257 Signal an error if color can't be allocated. */
1260 x_decode_color (f
, color_name
, mono_color
)
1262 Lisp_Object color_name
;
1267 CHECK_STRING (color_name
, 0);
1269 #if 0 /* Don't do this. It's wrong when we're not using the default
1270 colormap, it makes freeing difficult, and it's probably not
1271 an important optimization. */
1272 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1273 return BLACK_PIX_DEFAULT (f
);
1274 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1275 return WHITE_PIX_DEFAULT (f
);
1278 /* Return MONO_COLOR for monochrome frames. */
1279 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1282 /* x_defined_color is responsible for coping with failures
1283 by looking for a near-miss. */
1284 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1287 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1288 Fcons (color_name
, Qnil
)));
1293 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1294 the previous value of that parameter, NEW_VALUE is the new value. */
1297 x_set_line_spacing (f
, new_value
, old_value
)
1299 Lisp_Object new_value
, old_value
;
1301 if (NILP (new_value
))
1302 f
->extra_line_spacing
= 0;
1303 else if (NATNUMP (new_value
))
1304 f
->extra_line_spacing
= XFASTINT (new_value
);
1306 Fsignal (Qerror
, Fcons (build_string ("Illegal line-spacing"),
1307 Fcons (new_value
, Qnil
)));
1308 if (FRAME_VISIBLE_P (f
))
1313 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1314 the previous value of that parameter, NEW_VALUE is the new value. */
1317 x_set_screen_gamma (f
, new_value
, old_value
)
1319 Lisp_Object new_value
, old_value
;
1321 if (NILP (new_value
))
1323 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1324 /* The value 0.4545 is the normal viewing gamma. */
1325 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1327 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1328 Fcons (new_value
, Qnil
)));
1330 clear_face_cache (0);
1334 /* Functions called only from `x_set_frame_param'
1335 to set individual parameters.
1337 If FRAME_X_WINDOW (f) is 0,
1338 the frame is being created and its X-window does not exist yet.
1339 In that case, just record the parameter's new value
1340 in the standard place; do not attempt to change the window. */
1343 x_set_foreground_color (f
, arg
, oldval
)
1345 Lisp_Object arg
, oldval
;
1348 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1350 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1351 f
->output_data
.x
->foreground_pixel
= pixel
;
1353 if (FRAME_X_WINDOW (f
) != 0)
1356 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1357 f
->output_data
.x
->foreground_pixel
);
1358 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1359 f
->output_data
.x
->foreground_pixel
);
1361 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1362 if (FRAME_VISIBLE_P (f
))
1368 x_set_background_color (f
, arg
, oldval
)
1370 Lisp_Object arg
, oldval
;
1373 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1375 unload_color (f
, f
->output_data
.x
->background_pixel
);
1376 f
->output_data
.x
->background_pixel
= pixel
;
1378 if (FRAME_X_WINDOW (f
) != 0)
1381 /* The main frame area. */
1382 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1383 f
->output_data
.x
->background_pixel
);
1384 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1385 f
->output_data
.x
->background_pixel
);
1386 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1387 f
->output_data
.x
->background_pixel
);
1388 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1389 f
->output_data
.x
->background_pixel
);
1392 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1393 bar
= XSCROLL_BAR (bar
)->next
)
1394 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1395 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1396 f
->output_data
.x
->background_pixel
);
1400 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1402 if (FRAME_VISIBLE_P (f
))
1408 x_set_mouse_color (f
, arg
, oldval
)
1410 Lisp_Object arg
, oldval
;
1412 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1415 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1416 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1418 /* Don't let pointers be invisible. */
1419 if (mask_color
== pixel
1420 && mask_color
== f
->output_data
.x
->background_pixel
)
1421 pixel
= f
->output_data
.x
->foreground_pixel
;
1423 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1424 f
->output_data
.x
->mouse_pixel
= pixel
;
1428 /* It's not okay to crash if the user selects a screwy cursor. */
1429 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1431 if (!EQ (Qnil
, Vx_pointer_shape
))
1433 CHECK_NUMBER (Vx_pointer_shape
, 0);
1434 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1437 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1438 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1440 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1442 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1443 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1444 XINT (Vx_nontext_pointer_shape
));
1447 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1448 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1450 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1452 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1453 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1454 XINT (Vx_busy_pointer_shape
));
1457 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1458 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1460 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1461 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1463 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1464 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1465 XINT (Vx_mode_pointer_shape
));
1468 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1469 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1471 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1473 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1475 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1476 XINT (Vx_sensitive_text_pointer_shape
));
1479 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1481 /* Check and report errors with the above calls. */
1482 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1483 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1486 XColor fore_color
, back_color
;
1488 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1489 back_color
.pixel
= mask_color
;
1490 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1492 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1494 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1495 &fore_color
, &back_color
);
1496 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1497 &fore_color
, &back_color
);
1498 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1499 &fore_color
, &back_color
);
1500 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1501 &fore_color
, &back_color
);
1502 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1503 &fore_color
, &back_color
);
1506 if (FRAME_X_WINDOW (f
) != 0)
1507 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1509 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1510 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1511 f
->output_data
.x
->text_cursor
= cursor
;
1513 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1514 && f
->output_data
.x
->nontext_cursor
!= 0)
1515 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1516 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1518 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1519 && f
->output_data
.x
->busy_cursor
!= 0)
1520 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1521 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1523 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1524 && f
->output_data
.x
->modeline_cursor
!= 0)
1525 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1526 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1528 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1529 && f
->output_data
.x
->cross_cursor
!= 0)
1530 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1531 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1533 XFlush (FRAME_X_DISPLAY (f
));
1536 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1540 x_set_cursor_color (f
, arg
, oldval
)
1542 Lisp_Object arg
, oldval
;
1544 unsigned long fore_pixel
, pixel
;
1545 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1547 if (!NILP (Vx_cursor_fore_pixel
))
1549 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1550 WHITE_PIX_DEFAULT (f
));
1551 fore_pixel_allocated_p
= 1;
1554 fore_pixel
= f
->output_data
.x
->background_pixel
;
1556 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1557 pixel_allocated_p
= 1;
1559 /* Make sure that the cursor color differs from the background color. */
1560 if (pixel
== f
->output_data
.x
->background_pixel
)
1562 if (pixel_allocated_p
)
1564 x_free_colors (f
, &pixel
, 1);
1565 pixel_allocated_p
= 0;
1568 pixel
= f
->output_data
.x
->mouse_pixel
;
1569 if (pixel
== fore_pixel
)
1571 if (fore_pixel_allocated_p
)
1573 x_free_colors (f
, &fore_pixel
, 1);
1574 fore_pixel_allocated_p
= 0;
1576 fore_pixel
= f
->output_data
.x
->background_pixel
;
1580 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1581 if (!fore_pixel_allocated_p
)
1582 fore_pixel
= x_copy_color (f
, fore_pixel
);
1583 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1585 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1586 if (!pixel_allocated_p
)
1587 pixel
= x_copy_color (f
, pixel
);
1588 f
->output_data
.x
->cursor_pixel
= pixel
;
1590 if (FRAME_X_WINDOW (f
) != 0)
1593 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1594 f
->output_data
.x
->cursor_pixel
);
1595 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1599 if (FRAME_VISIBLE_P (f
))
1601 x_update_cursor (f
, 0);
1602 x_update_cursor (f
, 1);
1606 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1609 /* Set the border-color of frame F to value described by ARG.
1610 ARG can be a string naming a color.
1611 The border-color is used for the border that is drawn by the X server.
1612 Note that this does not fully take effect if done before
1613 F has an x-window; it must be redone when the window is created.
1615 Note: this is done in two routines because of the way X10 works.
1617 Note: under X11, this is normally the province of the window manager,
1618 and so emacs' border colors may be overridden. */
1621 x_set_border_color (f
, arg
, oldval
)
1623 Lisp_Object arg
, oldval
;
1627 CHECK_STRING (arg
, 0);
1628 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1629 x_set_border_pixel (f
, pix
);
1630 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1633 /* Set the border-color of frame F to pixel value PIX.
1634 Note that this does not fully take effect if done before
1635 F has an x-window. */
1638 x_set_border_pixel (f
, pix
)
1642 unload_color (f
, f
->output_data
.x
->border_pixel
);
1643 f
->output_data
.x
->border_pixel
= pix
;
1645 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1648 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1649 (unsigned long)pix
);
1652 if (FRAME_VISIBLE_P (f
))
1658 /* Value is the internal representation of the specified cursor type
1659 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1660 of the bar cursor. */
1662 enum text_cursor_kinds
1663 x_specified_cursor_type (arg
, width
)
1667 enum text_cursor_kinds type
;
1674 else if (CONSP (arg
)
1675 && EQ (XCAR (arg
), Qbar
)
1676 && INTEGERP (XCDR (arg
))
1677 && XINT (XCDR (arg
)) >= 0)
1680 *width
= XINT (XCDR (arg
));
1682 else if (NILP (arg
))
1685 /* Treat anything unknown as "box cursor".
1686 It was bad to signal an error; people have trouble fixing
1687 .Xdefaults with Emacs, when it has something bad in it. */
1688 type
= FILLED_BOX_CURSOR
;
1694 x_set_cursor_type (f
, arg
, oldval
)
1696 Lisp_Object arg
, oldval
;
1700 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1701 f
->output_data
.x
->cursor_width
= width
;
1703 /* Make sure the cursor gets redrawn. This is overkill, but how
1704 often do people change cursor types? */
1705 update_mode_lines
++;
1709 x_set_icon_type (f
, arg
, oldval
)
1711 Lisp_Object arg
, oldval
;
1717 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1720 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1725 result
= x_text_icon (f
,
1726 (char *) XSTRING ((!NILP (f
->icon_name
)
1730 result
= x_bitmap_icon (f
, arg
);
1735 error ("No icon window available");
1738 XFlush (FRAME_X_DISPLAY (f
));
1742 /* Return non-nil if frame F wants a bitmap icon. */
1750 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1758 x_set_icon_name (f
, arg
, oldval
)
1760 Lisp_Object arg
, oldval
;
1766 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1769 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1774 if (f
->output_data
.x
->icon_bitmap
!= 0)
1779 result
= x_text_icon (f
,
1780 (char *) XSTRING ((!NILP (f
->icon_name
)
1789 error ("No icon window available");
1792 XFlush (FRAME_X_DISPLAY (f
));
1797 x_set_font (f
, arg
, oldval
)
1799 Lisp_Object arg
, oldval
;
1802 Lisp_Object fontset_name
;
1805 CHECK_STRING (arg
, 1);
1807 fontset_name
= Fquery_fontset (arg
, Qnil
);
1810 result
= (STRINGP (fontset_name
)
1811 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1812 : x_new_font (f
, XSTRING (arg
)->data
));
1815 if (EQ (result
, Qnil
))
1816 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1817 else if (EQ (result
, Qt
))
1818 error ("The characters of the given font have varying widths");
1819 else if (STRINGP (result
))
1821 store_frame_param (f
, Qfont
, result
);
1822 recompute_basic_faces (f
);
1827 do_pending_window_change (0);
1829 /* Don't call `face-set-after-frame-default' when faces haven't been
1830 initialized yet. This is the case when called from
1831 Fx_create_frame. In that case, the X widget or window doesn't
1832 exist either, and we can end up in x_report_frame_params with a
1833 null widget which gives a segfault. */
1834 if (FRAME_FACE_CACHE (f
))
1836 XSETFRAME (frame
, f
);
1837 call1 (Qface_set_after_frame_default
, frame
);
1842 x_set_border_width (f
, arg
, oldval
)
1844 Lisp_Object arg
, oldval
;
1846 CHECK_NUMBER (arg
, 0);
1848 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1851 if (FRAME_X_WINDOW (f
) != 0)
1852 error ("Cannot change the border width of a window");
1854 f
->output_data
.x
->border_width
= XINT (arg
);
1858 x_set_internal_border_width (f
, arg
, oldval
)
1860 Lisp_Object arg
, oldval
;
1862 int old
= f
->output_data
.x
->internal_border_width
;
1864 CHECK_NUMBER (arg
, 0);
1865 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1866 if (f
->output_data
.x
->internal_border_width
< 0)
1867 f
->output_data
.x
->internal_border_width
= 0;
1869 #ifdef USE_X_TOOLKIT
1870 if (f
->output_data
.x
->edit_widget
)
1871 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1874 if (f
->output_data
.x
->internal_border_width
== old
)
1877 if (FRAME_X_WINDOW (f
) != 0)
1879 x_set_window_size (f
, 0, f
->width
, f
->height
);
1880 SET_FRAME_GARBAGED (f
);
1881 do_pending_window_change (0);
1886 x_set_visibility (f
, value
, oldval
)
1888 Lisp_Object value
, oldval
;
1891 XSETFRAME (frame
, f
);
1894 Fmake_frame_invisible (frame
, Qt
);
1895 else if (EQ (value
, Qicon
))
1896 Ficonify_frame (frame
);
1898 Fmake_frame_visible (frame
);
1902 x_set_menu_bar_lines_1 (window
, n
)
1906 struct window
*w
= XWINDOW (window
);
1908 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1909 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1911 if (INTEGERP (w
->orig_top
))
1912 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1913 if (INTEGERP (w
->orig_height
))
1914 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1916 /* Handle just the top child in a vertical split. */
1917 if (!NILP (w
->vchild
))
1918 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1920 /* Adjust all children in a horizontal split. */
1921 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1923 w
= XWINDOW (window
);
1924 x_set_menu_bar_lines_1 (window
, n
);
1929 x_set_menu_bar_lines (f
, value
, oldval
)
1931 Lisp_Object value
, oldval
;
1934 #ifndef USE_X_TOOLKIT
1935 int olines
= FRAME_MENU_BAR_LINES (f
);
1938 /* Right now, menu bars don't work properly in minibuf-only frames;
1939 most of the commands try to apply themselves to the minibuffer
1940 frame itself, and get an error because you can't switch buffers
1941 in or split the minibuffer window. */
1942 if (FRAME_MINIBUF_ONLY_P (f
))
1945 if (INTEGERP (value
))
1946 nlines
= XINT (value
);
1950 /* Make sure we redisplay all windows in this frame. */
1951 windows_or_buffers_changed
++;
1953 #ifdef USE_X_TOOLKIT
1954 FRAME_MENU_BAR_LINES (f
) = 0;
1957 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1958 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1959 /* Make sure next redisplay shows the menu bar. */
1960 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1964 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1965 free_frame_menubar (f
);
1966 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1968 f
->output_data
.x
->menubar_widget
= 0;
1970 #else /* not USE_X_TOOLKIT */
1971 FRAME_MENU_BAR_LINES (f
) = nlines
;
1972 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1973 #endif /* not USE_X_TOOLKIT */
1978 /* Set the number of lines used for the tool bar of frame F to VALUE.
1979 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1980 is the old number of tool bar lines. This function changes the
1981 height of all windows on frame F to match the new tool bar height.
1982 The frame's height doesn't change. */
1985 x_set_tool_bar_lines (f
, value
, oldval
)
1987 Lisp_Object value
, oldval
;
1991 /* Use VALUE only if an integer >= 0. */
1992 if (INTEGERP (value
) && XINT (value
) >= 0)
1993 nlines
= XFASTINT (value
);
1997 /* Make sure we redisplay all windows in this frame. */
1998 ++windows_or_buffers_changed
;
2000 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2001 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2002 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2007 /* Set the foreground color for scroll bars on frame F to VALUE.
2008 VALUE should be a string, a color name. If it isn't a string or
2009 isn't a valid color name, do nothing. OLDVAL is the old value of
2010 the frame parameter. */
2013 x_set_scroll_bar_foreground (f
, value
, oldval
)
2015 Lisp_Object value
, oldval
;
2017 unsigned long pixel
;
2019 if (STRINGP (value
))
2020 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2024 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2025 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2027 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2028 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2030 /* Remove all scroll bars because they have wrong colors. */
2031 if (condemn_scroll_bars_hook
)
2032 (*condemn_scroll_bars_hook
) (f
);
2033 if (judge_scroll_bars_hook
)
2034 (*judge_scroll_bars_hook
) (f
);
2036 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2042 /* Set the background color for scroll bars on frame F to VALUE VALUE
2043 should be a string, a color name. If it isn't a string or isn't a
2044 valid color name, do nothing. OLDVAL is the old value of the frame
2048 x_set_scroll_bar_background (f
, value
, oldval
)
2050 Lisp_Object value
, oldval
;
2052 unsigned long pixel
;
2054 if (STRINGP (value
))
2055 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2059 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2060 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2062 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2063 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2065 /* Remove all scroll bars because they have wrong colors. */
2066 if (condemn_scroll_bars_hook
)
2067 (*condemn_scroll_bars_hook
) (f
);
2068 if (judge_scroll_bars_hook
)
2069 (*judge_scroll_bars_hook
) (f
);
2071 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2077 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2080 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2081 name; if NAME is a string, set F's name to NAME and set
2082 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2084 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2085 suggesting a new name, which lisp code should override; if
2086 F->explicit_name is set, ignore the new name; otherwise, set it. */
2089 x_set_name (f
, name
, explicit)
2094 /* Make sure that requests from lisp code override requests from
2095 Emacs redisplay code. */
2098 /* If we're switching from explicit to implicit, we had better
2099 update the mode lines and thereby update the title. */
2100 if (f
->explicit_name
&& NILP (name
))
2101 update_mode_lines
= 1;
2103 f
->explicit_name
= ! NILP (name
);
2105 else if (f
->explicit_name
)
2108 /* If NAME is nil, set the name to the x_id_name. */
2111 /* Check for no change needed in this very common case
2112 before we do any consing. */
2113 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2114 XSTRING (f
->name
)->data
))
2116 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2119 CHECK_STRING (name
, 0);
2121 /* Don't change the name if it's already NAME. */
2122 if (! NILP (Fstring_equal (name
, f
->name
)))
2127 /* For setting the frame title, the title parameter should override
2128 the name parameter. */
2129 if (! NILP (f
->title
))
2132 if (FRAME_X_WINDOW (f
))
2137 XTextProperty text
, icon
;
2138 Lisp_Object icon_name
;
2140 text
.value
= XSTRING (name
)->data
;
2141 text
.encoding
= XA_STRING
;
2143 text
.nitems
= STRING_BYTES (XSTRING (name
));
2145 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2147 icon
.value
= XSTRING (icon_name
)->data
;
2148 icon
.encoding
= XA_STRING
;
2150 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2151 #ifdef USE_X_TOOLKIT
2152 XSetWMName (FRAME_X_DISPLAY (f
),
2153 XtWindow (f
->output_data
.x
->widget
), &text
);
2154 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2156 #else /* not USE_X_TOOLKIT */
2157 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2158 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2159 #endif /* not USE_X_TOOLKIT */
2161 #else /* not HAVE_X11R4 */
2162 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2163 XSTRING (name
)->data
);
2164 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2165 XSTRING (name
)->data
);
2166 #endif /* not HAVE_X11R4 */
2171 /* This function should be called when the user's lisp code has
2172 specified a name for the frame; the name will override any set by the
2175 x_explicitly_set_name (f
, arg
, oldval
)
2177 Lisp_Object arg
, oldval
;
2179 x_set_name (f
, arg
, 1);
2182 /* This function should be called by Emacs redisplay code to set the
2183 name; names set this way will never override names set by the user's
2186 x_implicitly_set_name (f
, arg
, oldval
)
2188 Lisp_Object arg
, oldval
;
2190 x_set_name (f
, arg
, 0);
2193 /* Change the title of frame F to NAME.
2194 If NAME is nil, use the frame name as the title.
2196 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2197 name; if NAME is a string, set F's name to NAME and set
2198 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2200 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2201 suggesting a new name, which lisp code should override; if
2202 F->explicit_name is set, ignore the new name; otherwise, set it. */
2205 x_set_title (f
, name
, old_name
)
2207 Lisp_Object name
, old_name
;
2209 /* Don't change the title if it's already NAME. */
2210 if (EQ (name
, f
->title
))
2213 update_mode_lines
= 1;
2220 CHECK_STRING (name
, 0);
2222 if (FRAME_X_WINDOW (f
))
2227 XTextProperty text
, icon
;
2228 Lisp_Object icon_name
;
2230 text
.value
= XSTRING (name
)->data
;
2231 text
.encoding
= XA_STRING
;
2233 text
.nitems
= STRING_BYTES (XSTRING (name
));
2235 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2237 icon
.value
= XSTRING (icon_name
)->data
;
2238 icon
.encoding
= XA_STRING
;
2240 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2241 #ifdef USE_X_TOOLKIT
2242 XSetWMName (FRAME_X_DISPLAY (f
),
2243 XtWindow (f
->output_data
.x
->widget
), &text
);
2244 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2246 #else /* not USE_X_TOOLKIT */
2247 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2248 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2249 #endif /* not USE_X_TOOLKIT */
2251 #else /* not HAVE_X11R4 */
2252 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2253 XSTRING (name
)->data
);
2254 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2255 XSTRING (name
)->data
);
2256 #endif /* not HAVE_X11R4 */
2262 x_set_autoraise (f
, arg
, oldval
)
2264 Lisp_Object arg
, oldval
;
2266 f
->auto_raise
= !EQ (Qnil
, arg
);
2270 x_set_autolower (f
, arg
, oldval
)
2272 Lisp_Object arg
, oldval
;
2274 f
->auto_lower
= !EQ (Qnil
, arg
);
2278 x_set_unsplittable (f
, arg
, oldval
)
2280 Lisp_Object arg
, oldval
;
2282 f
->no_split
= !NILP (arg
);
2286 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2288 Lisp_Object arg
, oldval
;
2290 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2291 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2292 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2293 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2295 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2297 ? vertical_scroll_bar_none
2299 ? vertical_scroll_bar_right
2300 : vertical_scroll_bar_left
);
2302 /* We set this parameter before creating the X window for the
2303 frame, so we can get the geometry right from the start.
2304 However, if the window hasn't been created yet, we shouldn't
2305 call x_set_window_size. */
2306 if (FRAME_X_WINDOW (f
))
2307 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2308 do_pending_window_change (0);
2313 x_set_scroll_bar_width (f
, arg
, oldval
)
2315 Lisp_Object arg
, oldval
;
2317 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2321 #ifdef USE_TOOLKIT_SCROLL_BARS
2322 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2323 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2324 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2325 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2327 /* Make the actual width at least 14 pixels and a multiple of a
2329 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2331 /* Use all of that space (aside from required margins) for the
2333 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2336 if (FRAME_X_WINDOW (f
))
2337 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2338 do_pending_window_change (0);
2340 else if (INTEGERP (arg
) && XINT (arg
) > 0
2341 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2343 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2344 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2346 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2347 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2348 if (FRAME_X_WINDOW (f
))
2349 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2352 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2353 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2354 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2359 /* Subroutines of creating an X frame. */
2361 /* Make sure that Vx_resource_name is set to a reasonable value.
2362 Fix it up, or set it to `emacs' if it is too hopeless. */
2365 validate_x_resource_name ()
2368 /* Number of valid characters in the resource name. */
2370 /* Number of invalid characters in the resource name. */
2375 if (!STRINGP (Vx_resource_class
))
2376 Vx_resource_class
= build_string (EMACS_CLASS
);
2378 if (STRINGP (Vx_resource_name
))
2380 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2383 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2385 /* Only letters, digits, - and _ are valid in resource names.
2386 Count the valid characters and count the invalid ones. */
2387 for (i
= 0; i
< len
; i
++)
2390 if (! ((c
>= 'a' && c
<= 'z')
2391 || (c
>= 'A' && c
<= 'Z')
2392 || (c
>= '0' && c
<= '9')
2393 || c
== '-' || c
== '_'))
2400 /* Not a string => completely invalid. */
2401 bad_count
= 5, good_count
= 0;
2403 /* If name is valid already, return. */
2407 /* If name is entirely invalid, or nearly so, use `emacs'. */
2409 || (good_count
== 1 && bad_count
> 0))
2411 Vx_resource_name
= build_string ("emacs");
2415 /* Name is partly valid. Copy it and replace the invalid characters
2416 with underscores. */
2418 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2420 for (i
= 0; i
< len
; i
++)
2422 int c
= XSTRING (new)->data
[i
];
2423 if (! ((c
>= 'a' && c
<= 'z')
2424 || (c
>= 'A' && c
<= 'Z')
2425 || (c
>= '0' && c
<= '9')
2426 || c
== '-' || c
== '_'))
2427 XSTRING (new)->data
[i
] = '_';
2432 extern char *x_get_string_resource ();
2434 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2435 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2436 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2437 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2438 the name specified by the `-name' or `-rn' command-line arguments.\n\
2440 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2441 class, respectively. You must specify both of them or neither.\n\
2442 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2443 and the class is `Emacs.CLASS.SUBCLASS'.")
2444 (attribute
, class, component
, subclass
)
2445 Lisp_Object attribute
, class, component
, subclass
;
2447 register char *value
;
2453 CHECK_STRING (attribute
, 0);
2454 CHECK_STRING (class, 0);
2456 if (!NILP (component
))
2457 CHECK_STRING (component
, 1);
2458 if (!NILP (subclass
))
2459 CHECK_STRING (subclass
, 2);
2460 if (NILP (component
) != NILP (subclass
))
2461 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2463 validate_x_resource_name ();
2465 /* Allocate space for the components, the dots which separate them,
2466 and the final '\0'. Make them big enough for the worst case. */
2467 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2468 + (STRINGP (component
)
2469 ? STRING_BYTES (XSTRING (component
)) : 0)
2470 + STRING_BYTES (XSTRING (attribute
))
2473 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2474 + STRING_BYTES (XSTRING (class))
2475 + (STRINGP (subclass
)
2476 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2479 /* Start with emacs.FRAMENAME for the name (the specific one)
2480 and with `Emacs' for the class key (the general one). */
2481 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2482 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2484 strcat (class_key
, ".");
2485 strcat (class_key
, XSTRING (class)->data
);
2487 if (!NILP (component
))
2489 strcat (class_key
, ".");
2490 strcat (class_key
, XSTRING (subclass
)->data
);
2492 strcat (name_key
, ".");
2493 strcat (name_key
, XSTRING (component
)->data
);
2496 strcat (name_key
, ".");
2497 strcat (name_key
, XSTRING (attribute
)->data
);
2499 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2500 name_key
, class_key
);
2502 if (value
!= (char *) 0)
2503 return build_string (value
);
2508 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2511 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2512 struct x_display_info
*dpyinfo
;
2513 Lisp_Object attribute
, class, component
, subclass
;
2515 register char *value
;
2519 CHECK_STRING (attribute
, 0);
2520 CHECK_STRING (class, 0);
2522 if (!NILP (component
))
2523 CHECK_STRING (component
, 1);
2524 if (!NILP (subclass
))
2525 CHECK_STRING (subclass
, 2);
2526 if (NILP (component
) != NILP (subclass
))
2527 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2529 validate_x_resource_name ();
2531 /* Allocate space for the components, the dots which separate them,
2532 and the final '\0'. Make them big enough for the worst case. */
2533 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2534 + (STRINGP (component
)
2535 ? STRING_BYTES (XSTRING (component
)) : 0)
2536 + STRING_BYTES (XSTRING (attribute
))
2539 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2540 + STRING_BYTES (XSTRING (class))
2541 + (STRINGP (subclass
)
2542 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2545 /* Start with emacs.FRAMENAME for the name (the specific one)
2546 and with `Emacs' for the class key (the general one). */
2547 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2548 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2550 strcat (class_key
, ".");
2551 strcat (class_key
, XSTRING (class)->data
);
2553 if (!NILP (component
))
2555 strcat (class_key
, ".");
2556 strcat (class_key
, XSTRING (subclass
)->data
);
2558 strcat (name_key
, ".");
2559 strcat (name_key
, XSTRING (component
)->data
);
2562 strcat (name_key
, ".");
2563 strcat (name_key
, XSTRING (attribute
)->data
);
2565 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2567 if (value
!= (char *) 0)
2568 return build_string (value
);
2573 /* Used when C code wants a resource value. */
2576 x_get_resource_string (attribute
, class)
2577 char *attribute
, *class;
2581 struct frame
*sf
= SELECTED_FRAME ();
2583 /* Allocate space for the components, the dots which separate them,
2584 and the final '\0'. */
2585 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2586 + strlen (attribute
) + 2);
2587 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2588 + strlen (class) + 2);
2590 sprintf (name_key
, "%s.%s",
2591 XSTRING (Vinvocation_name
)->data
,
2593 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2595 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2596 name_key
, class_key
);
2599 /* Types we might convert a resource string into. */
2609 /* Return the value of parameter PARAM.
2611 First search ALIST, then Vdefault_frame_alist, then the X defaults
2612 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2614 Convert the resource to the type specified by desired_type.
2616 If no default is specified, return Qunbound. If you call
2617 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2618 and don't let it get stored in any Lisp-visible variables! */
2621 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2622 struct x_display_info
*dpyinfo
;
2623 Lisp_Object alist
, param
;
2626 enum resource_types type
;
2628 register Lisp_Object tem
;
2630 tem
= Fassq (param
, alist
);
2632 tem
= Fassq (param
, Vdefault_frame_alist
);
2638 tem
= display_x_get_resource (dpyinfo
,
2639 build_string (attribute
),
2640 build_string (class),
2648 case RES_TYPE_NUMBER
:
2649 return make_number (atoi (XSTRING (tem
)->data
));
2651 case RES_TYPE_FLOAT
:
2652 return make_float (atof (XSTRING (tem
)->data
));
2654 case RES_TYPE_BOOLEAN
:
2655 tem
= Fdowncase (tem
);
2656 if (!strcmp (XSTRING (tem
)->data
, "on")
2657 || !strcmp (XSTRING (tem
)->data
, "true"))
2662 case RES_TYPE_STRING
:
2665 case RES_TYPE_SYMBOL
:
2666 /* As a special case, we map the values `true' and `on'
2667 to Qt, and `false' and `off' to Qnil. */
2670 lower
= Fdowncase (tem
);
2671 if (!strcmp (XSTRING (lower
)->data
, "on")
2672 || !strcmp (XSTRING (lower
)->data
, "true"))
2674 else if (!strcmp (XSTRING (lower
)->data
, "off")
2675 || !strcmp (XSTRING (lower
)->data
, "false"))
2678 return Fintern (tem
, Qnil
);
2691 /* Like x_get_arg, but also record the value in f->param_alist. */
2694 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2696 Lisp_Object alist
, param
;
2699 enum resource_types type
;
2703 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2704 attribute
, class, type
);
2706 store_frame_param (f
, param
, value
);
2711 /* Record in frame F the specified or default value according to ALIST
2712 of the parameter named PROP (a Lisp symbol).
2713 If no value is specified for PROP, look for an X default for XPROP
2714 on the frame named NAME.
2715 If that is not found either, use the value DEFLT. */
2718 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2725 enum resource_types type
;
2729 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2730 if (EQ (tem
, Qunbound
))
2732 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2737 /* Record in frame F the specified or default value according to ALIST
2738 of the parameter named PROP (a Lisp symbol). If no value is
2739 specified for PROP, look for an X default for XPROP on the frame
2740 named NAME. If that is not found either, use the value DEFLT. */
2743 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2752 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2755 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2756 if (EQ (tem
, Qunbound
))
2758 #ifdef USE_TOOLKIT_SCROLL_BARS
2760 /* See if an X resource for the scroll bar color has been
2762 tem
= display_x_get_resource (dpyinfo
,
2763 build_string (foreground_p
2767 build_string ("verticalScrollBar"),
2771 /* If nothing has been specified, scroll bars will use a
2772 toolkit-dependent default. Because these defaults are
2773 difficult to get at without actually creating a scroll
2774 bar, use nil to indicate that no color has been
2779 #else /* not USE_TOOLKIT_SCROLL_BARS */
2783 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2786 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2792 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2793 "Parse an X-style geometry string STRING.\n\
2794 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2795 The properties returned may include `top', `left', `height', and `width'.\n\
2796 The value of `left' or `top' may be an integer,\n\
2797 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2798 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2803 unsigned int width
, height
;
2806 CHECK_STRING (string
, 0);
2808 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2809 &x
, &y
, &width
, &height
);
2812 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2813 error ("Must specify both x and y position, or neither");
2817 if (geometry
& XValue
)
2819 Lisp_Object element
;
2821 if (x
>= 0 && (geometry
& XNegative
))
2822 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2823 else if (x
< 0 && ! (geometry
& XNegative
))
2824 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2826 element
= Fcons (Qleft
, make_number (x
));
2827 result
= Fcons (element
, result
);
2830 if (geometry
& YValue
)
2832 Lisp_Object element
;
2834 if (y
>= 0 && (geometry
& YNegative
))
2835 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2836 else if (y
< 0 && ! (geometry
& YNegative
))
2837 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2839 element
= Fcons (Qtop
, make_number (y
));
2840 result
= Fcons (element
, result
);
2843 if (geometry
& WidthValue
)
2844 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2845 if (geometry
& HeightValue
)
2846 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2851 /* Calculate the desired size and position of this window,
2852 and return the flags saying which aspects were specified.
2854 This function does not make the coordinates positive. */
2856 #define DEFAULT_ROWS 40
2857 #define DEFAULT_COLS 80
2860 x_figure_window_size (f
, parms
)
2864 register Lisp_Object tem0
, tem1
, tem2
;
2865 long window_prompting
= 0;
2866 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2868 /* Default values if we fall through.
2869 Actually, if that happens we should get
2870 window manager prompting. */
2871 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2872 f
->height
= DEFAULT_ROWS
;
2873 /* Window managers expect that if program-specified
2874 positions are not (0,0), they're intentional, not defaults. */
2875 f
->output_data
.x
->top_pos
= 0;
2876 f
->output_data
.x
->left_pos
= 0;
2878 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2879 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2880 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2881 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2883 if (!EQ (tem0
, Qunbound
))
2885 CHECK_NUMBER (tem0
, 0);
2886 f
->height
= XINT (tem0
);
2888 if (!EQ (tem1
, Qunbound
))
2890 CHECK_NUMBER (tem1
, 0);
2891 SET_FRAME_WIDTH (f
, XINT (tem1
));
2893 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2894 window_prompting
|= USSize
;
2896 window_prompting
|= PSize
;
2899 f
->output_data
.x
->vertical_scroll_bar_extra
2900 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2902 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2903 f
->output_data
.x
->flags_areas_extra
2904 = FRAME_FLAGS_AREA_WIDTH (f
);
2905 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2906 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2908 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2909 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2910 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2911 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2913 if (EQ (tem0
, Qminus
))
2915 f
->output_data
.x
->top_pos
= 0;
2916 window_prompting
|= YNegative
;
2918 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2919 && CONSP (XCDR (tem0
))
2920 && INTEGERP (XCAR (XCDR (tem0
))))
2922 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2923 window_prompting
|= YNegative
;
2925 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2926 && CONSP (XCDR (tem0
))
2927 && INTEGERP (XCAR (XCDR (tem0
))))
2929 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2931 else if (EQ (tem0
, Qunbound
))
2932 f
->output_data
.x
->top_pos
= 0;
2935 CHECK_NUMBER (tem0
, 0);
2936 f
->output_data
.x
->top_pos
= XINT (tem0
);
2937 if (f
->output_data
.x
->top_pos
< 0)
2938 window_prompting
|= YNegative
;
2941 if (EQ (tem1
, Qminus
))
2943 f
->output_data
.x
->left_pos
= 0;
2944 window_prompting
|= XNegative
;
2946 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2947 && CONSP (XCDR (tem1
))
2948 && INTEGERP (XCAR (XCDR (tem1
))))
2950 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2951 window_prompting
|= XNegative
;
2953 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2954 && CONSP (XCDR (tem1
))
2955 && INTEGERP (XCAR (XCDR (tem1
))))
2957 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2959 else if (EQ (tem1
, Qunbound
))
2960 f
->output_data
.x
->left_pos
= 0;
2963 CHECK_NUMBER (tem1
, 0);
2964 f
->output_data
.x
->left_pos
= XINT (tem1
);
2965 if (f
->output_data
.x
->left_pos
< 0)
2966 window_prompting
|= XNegative
;
2969 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2970 window_prompting
|= USPosition
;
2972 window_prompting
|= PPosition
;
2975 return window_prompting
;
2978 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2981 XSetWMProtocols (dpy
, w
, protocols
, count
)
2988 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2989 if (prop
== None
) return False
;
2990 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2991 (unsigned char *) protocols
, count
);
2994 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2996 #ifdef USE_X_TOOLKIT
2998 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2999 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3000 already be present because of the toolkit (Motif adds some of them,
3001 for example, but Xt doesn't). */
3004 hack_wm_protocols (f
, widget
)
3008 Display
*dpy
= XtDisplay (widget
);
3009 Window w
= XtWindow (widget
);
3010 int need_delete
= 1;
3016 Atom type
, *atoms
= 0;
3018 unsigned long nitems
= 0;
3019 unsigned long bytes_after
;
3021 if ((XGetWindowProperty (dpy
, w
,
3022 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3023 (long)0, (long)100, False
, XA_ATOM
,
3024 &type
, &format
, &nitems
, &bytes_after
,
3025 (unsigned char **) &atoms
)
3027 && format
== 32 && type
== XA_ATOM
)
3031 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3033 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3035 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3038 if (atoms
) XFree ((char *) atoms
);
3044 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3046 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3048 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3050 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3051 XA_ATOM
, 32, PropModeAppend
,
3052 (unsigned char *) props
, count
);
3060 /* Support routines for XIC (X Input Context). */
3064 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3065 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3068 /* Supported XIM styles, ordered by preferenc. */
3070 static XIMStyle supported_xim_styles
[] =
3072 XIMPreeditPosition
| XIMStatusArea
,
3073 XIMPreeditPosition
| XIMStatusNothing
,
3074 XIMPreeditPosition
| XIMStatusNone
,
3075 XIMPreeditNothing
| XIMStatusArea
,
3076 XIMPreeditNothing
| XIMStatusNothing
,
3077 XIMPreeditNothing
| XIMStatusNone
,
3078 XIMPreeditNone
| XIMStatusArea
,
3079 XIMPreeditNone
| XIMStatusNothing
,
3080 XIMPreeditNone
| XIMStatusNone
,
3085 /* Create an X fontset on frame F with base font name
3089 xic_create_xfontset (f
, base_fontname
)
3091 char *base_fontname
;
3094 char **missing_list
;
3098 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3099 base_fontname
, &missing_list
,
3100 &missing_count
, &def_string
);
3102 XFreeStringList (missing_list
);
3104 /* No need to free def_string. */
3109 /* Value is the best input style, given user preferences USER (already
3110 checked to be supported by Emacs), and styles supported by the
3111 input method XIM. */
3114 best_xim_style (user
, xim
)
3120 for (i
= 0; i
< user
->count_styles
; ++i
)
3121 for (j
= 0; j
< xim
->count_styles
; ++j
)
3122 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3123 return user
->supported_styles
[i
];
3125 /* Return the default style. */
3126 return XIMPreeditNothing
| XIMStatusNothing
;
3129 /* Create XIC for frame F. */
3132 create_frame_xic (f
)
3137 XFontSet xfs
= NULL
;
3138 static XIMStyle xic_style
;
3143 xim
= FRAME_X_XIM (f
);
3148 XVaNestedList preedit_attr
;
3149 XVaNestedList status_attr
;
3150 char *base_fontname
;
3153 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3154 spot
.x
= 0; spot
.y
= 1;
3155 /* Create X fontset. */
3156 fontset
= FRAME_FONTSET (f
);
3158 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3161 /* Determine the base fontname from the ASCII font name of
3163 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3164 char *p
= ascii_font
;
3167 for (i
= 0; *p
; p
++)
3170 /* As the font name doesn't conform to XLFD, we can't
3171 modify it to get a suitable base fontname for the
3173 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3176 int len
= strlen (ascii_font
) + 1;
3179 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3188 base_fontname
= (char *) alloca (len
);
3189 bzero (base_fontname
, len
);
3190 strcpy (base_fontname
, "-*-*-");
3191 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3192 strcat (base_fontname
, "*-*-*-*-*-*-*");
3195 xfs
= xic_create_xfontset (f
, base_fontname
);
3197 /* Determine XIC style. */
3200 XIMStyles supported_list
;
3201 supported_list
.count_styles
= (sizeof supported_xim_styles
3202 / sizeof supported_xim_styles
[0]);
3203 supported_list
.supported_styles
= supported_xim_styles
;
3204 xic_style
= best_xim_style (&supported_list
,
3205 FRAME_X_XIM_STYLES (f
));
3208 preedit_attr
= XVaCreateNestedList (0,
3211 FRAME_FOREGROUND_PIXEL (f
),
3213 FRAME_BACKGROUND_PIXEL (f
),
3214 (xic_style
& XIMPreeditPosition
3219 status_attr
= XVaCreateNestedList (0,
3225 FRAME_FOREGROUND_PIXEL (f
),
3227 FRAME_BACKGROUND_PIXEL (f
),
3230 xic
= XCreateIC (xim
,
3231 XNInputStyle
, xic_style
,
3232 XNClientWindow
, FRAME_X_WINDOW(f
),
3233 XNFocusWindow
, FRAME_X_WINDOW(f
),
3234 XNStatusAttributes
, status_attr
,
3235 XNPreeditAttributes
, preedit_attr
,
3237 XFree (preedit_attr
);
3238 XFree (status_attr
);
3241 FRAME_XIC (f
) = xic
;
3242 FRAME_XIC_STYLE (f
) = xic_style
;
3243 FRAME_XIC_FONTSET (f
) = xfs
;
3247 /* Destroy XIC and free XIC fontset of frame F, if any. */
3253 if (FRAME_XIC (f
) == NULL
)
3256 XDestroyIC (FRAME_XIC (f
));
3257 if (FRAME_XIC_FONTSET (f
))
3258 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3260 FRAME_XIC (f
) = NULL
;
3261 FRAME_XIC_FONTSET (f
) = NULL
;
3265 /* Place preedit area for XIC of window W's frame to specified
3266 pixel position X/Y. X and Y are relative to window W. */
3269 xic_set_preeditarea (w
, x
, y
)
3273 struct frame
*f
= XFRAME (w
->frame
);
3277 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3278 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3279 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3280 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3285 /* Place status area for XIC in bottom right corner of frame F.. */
3288 xic_set_statusarea (f
)
3291 XIC xic
= FRAME_XIC (f
);
3296 /* Negotiate geometry of status area. If input method has existing
3297 status area, use its current size. */
3298 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3299 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3300 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3303 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3304 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3307 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3309 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3310 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3314 area
.width
= needed
->width
;
3315 area
.height
= needed
->height
;
3316 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3317 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3318 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3321 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3322 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3327 /* Set X fontset for XIC of frame F, using base font name
3328 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3331 xic_set_xfontset (f
, base_fontname
)
3333 char *base_fontname
;
3338 xfs
= xic_create_xfontset (f
, base_fontname
);
3340 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3341 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3342 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3343 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3344 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3347 if (FRAME_XIC_FONTSET (f
))
3348 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3349 FRAME_XIC_FONTSET (f
) = xfs
;
3352 #endif /* HAVE_X_I18N */
3356 #ifdef USE_X_TOOLKIT
3358 /* Create and set up the X widget for frame F. */
3361 x_window (f
, window_prompting
, minibuffer_only
)
3363 long window_prompting
;
3364 int minibuffer_only
;
3366 XClassHint class_hints
;
3367 XSetWindowAttributes attributes
;
3368 unsigned long attribute_mask
;
3369 Widget shell_widget
;
3371 Widget frame_widget
;
3377 /* Use the resource name as the top-level widget name
3378 for looking up resources. Make a non-Lisp copy
3379 for the window manager, so GC relocation won't bother it.
3381 Elsewhere we specify the window name for the window manager. */
3384 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3385 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3386 strcpy (f
->namebuf
, str
);
3390 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3391 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3392 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3393 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3394 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3395 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3396 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3397 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3398 applicationShellWidgetClass
,
3399 FRAME_X_DISPLAY (f
), al
, ac
);
3401 f
->output_data
.x
->widget
= shell_widget
;
3402 /* maybe_set_screen_title_format (shell_widget); */
3404 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3405 (widget_value
*) NULL
,
3406 shell_widget
, False
,
3410 (lw_callback
) NULL
);
3413 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3414 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3415 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3416 XtSetValues (pane_widget
, al
, ac
);
3417 f
->output_data
.x
->column_widget
= pane_widget
;
3419 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3420 the emacs screen when changing menubar. This reduces flickering. */
3423 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3424 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3425 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3426 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3427 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3428 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3429 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3430 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3431 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3434 f
->output_data
.x
->edit_widget
= frame_widget
;
3436 XtManageChild (frame_widget
);
3438 /* Do some needed geometry management. */
3441 char *tem
, shell_position
[32];
3444 int extra_borders
= 0;
3446 = (f
->output_data
.x
->menubar_widget
3447 ? (f
->output_data
.x
->menubar_widget
->core
.height
3448 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3451 #if 0 /* Experimentally, we now get the right results
3452 for -geometry -0-0 without this. 24 Aug 96, rms. */
3453 if (FRAME_EXTERNAL_MENU_BAR (f
))
3456 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3457 menubar_size
+= ibw
;
3461 f
->output_data
.x
->menubar_height
= menubar_size
;
3464 /* Motif seems to need this amount added to the sizes
3465 specified for the shell widget. The Athena/Lucid widgets don't.
3466 Both conclusions reached experimentally. -- rms. */
3467 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3468 &extra_borders
, NULL
);
3472 /* Convert our geometry parameters into a geometry string
3474 Note that we do not specify here whether the position
3475 is a user-specified or program-specified one.
3476 We pass that information later, in x_wm_set_size_hints. */
3478 int left
= f
->output_data
.x
->left_pos
;
3479 int xneg
= window_prompting
& XNegative
;
3480 int top
= f
->output_data
.x
->top_pos
;
3481 int yneg
= window_prompting
& YNegative
;
3487 if (window_prompting
& USPosition
)
3488 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3489 PIXEL_WIDTH (f
) + extra_borders
,
3490 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3491 (xneg
? '-' : '+'), left
,
3492 (yneg
? '-' : '+'), top
);
3494 sprintf (shell_position
, "=%dx%d",
3495 PIXEL_WIDTH (f
) + extra_borders
,
3496 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3499 len
= strlen (shell_position
) + 1;
3500 /* We don't free this because we don't know whether
3501 it is safe to free it while the frame exists.
3502 It isn't worth the trouble of arranging to free it
3503 when the frame is deleted. */
3504 tem
= (char *) xmalloc (len
);
3505 strncpy (tem
, shell_position
, len
);
3506 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3507 XtSetValues (shell_widget
, al
, ac
);
3510 XtManageChild (pane_widget
);
3511 XtRealizeWidget (shell_widget
);
3513 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3515 validate_x_resource_name ();
3517 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3518 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3519 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3522 FRAME_XIC (f
) = NULL
;
3523 create_frame_xic (f
);
3526 f
->output_data
.x
->wm_hints
.input
= True
;
3527 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3528 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3529 &f
->output_data
.x
->wm_hints
);
3531 hack_wm_protocols (f
, shell_widget
);
3534 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3537 /* Do a stupid property change to force the server to generate a
3538 PropertyNotify event so that the event_stream server timestamp will
3539 be initialized to something relevant to the time we created the window.
3541 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3542 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3543 XA_ATOM
, 32, PropModeAppend
,
3544 (unsigned char*) NULL
, 0);
3546 /* Make all the standard events reach the Emacs frame. */
3547 attributes
.event_mask
= STANDARD_EVENT_SET
;
3552 /* XIM server might require some X events. */
3553 unsigned long fevent
= NoEventMask
;
3554 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3555 attributes
.event_mask
|= fevent
;
3557 #endif /* HAVE_X_I18N */
3559 attribute_mask
= CWEventMask
;
3560 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3561 attribute_mask
, &attributes
);
3563 XtMapWidget (frame_widget
);
3565 /* x_set_name normally ignores requests to set the name if the
3566 requested name is the same as the current name. This is the one
3567 place where that assumption isn't correct; f->name is set, but
3568 the X server hasn't been told. */
3571 int explicit = f
->explicit_name
;
3573 f
->explicit_name
= 0;
3576 x_set_name (f
, name
, explicit);
3579 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3580 f
->output_data
.x
->text_cursor
);
3584 /* This is a no-op, except under Motif. Make sure main areas are
3585 set to something reasonable, in case we get an error later. */
3586 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3589 #else /* not USE_X_TOOLKIT */
3591 /* Create and set up the X window for frame F. */
3598 XClassHint class_hints
;
3599 XSetWindowAttributes attributes
;
3600 unsigned long attribute_mask
;
3602 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3603 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3604 attributes
.bit_gravity
= StaticGravity
;
3605 attributes
.backing_store
= NotUseful
;
3606 attributes
.save_under
= True
;
3607 attributes
.event_mask
= STANDARD_EVENT_SET
;
3608 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3609 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3614 = XCreateWindow (FRAME_X_DISPLAY (f
),
3615 f
->output_data
.x
->parent_desc
,
3616 f
->output_data
.x
->left_pos
,
3617 f
->output_data
.x
->top_pos
,
3618 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3619 f
->output_data
.x
->border_width
,
3620 CopyFromParent
, /* depth */
3621 InputOutput
, /* class */
3623 attribute_mask
, &attributes
);
3626 create_frame_xic (f
);
3629 /* XIM server might require some X events. */
3630 unsigned long fevent
= NoEventMask
;
3631 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3632 attributes
.event_mask
|= fevent
;
3633 attribute_mask
= CWEventMask
;
3634 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3635 attribute_mask
, &attributes
);
3637 #endif /* HAVE_X_I18N */
3639 validate_x_resource_name ();
3641 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3642 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3643 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3645 /* The menubar is part of the ordinary display;
3646 it does not count in addition to the height of the window. */
3647 f
->output_data
.x
->menubar_height
= 0;
3649 /* This indicates that we use the "Passive Input" input model.
3650 Unless we do this, we don't get the Focus{In,Out} events that we
3651 need to draw the cursor correctly. Accursed bureaucrats.
3652 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3654 f
->output_data
.x
->wm_hints
.input
= True
;
3655 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3656 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3657 &f
->output_data
.x
->wm_hints
);
3658 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3660 /* Request "save yourself" and "delete window" commands from wm. */
3663 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3664 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3665 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3668 /* x_set_name normally ignores requests to set the name if the
3669 requested name is the same as the current name. This is the one
3670 place where that assumption isn't correct; f->name is set, but
3671 the X server hasn't been told. */
3674 int explicit = f
->explicit_name
;
3676 f
->explicit_name
= 0;
3679 x_set_name (f
, name
, explicit);
3682 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3683 f
->output_data
.x
->text_cursor
);
3687 if (FRAME_X_WINDOW (f
) == 0)
3688 error ("Unable to create window");
3691 #endif /* not USE_X_TOOLKIT */
3693 /* Handle the icon stuff for this window. Perhaps later we might
3694 want an x_set_icon_position which can be called interactively as
3702 Lisp_Object icon_x
, icon_y
;
3703 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3705 /* Set the position of the icon. Note that twm groups all
3706 icons in an icon window. */
3707 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3708 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3709 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3711 CHECK_NUMBER (icon_x
, 0);
3712 CHECK_NUMBER (icon_y
, 0);
3714 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3715 error ("Both left and top icon corners of icon must be specified");
3719 if (! EQ (icon_x
, Qunbound
))
3720 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3722 /* Start up iconic or window? */
3723 x_wm_set_window_state
3724 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3729 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3736 /* Make the GC's needed for this window, setting the
3737 background, border and mouse colors; also create the
3738 mouse cursor and the gray border tile. */
3740 static char cursor_bits
[] =
3742 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3743 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3744 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3745 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3752 XGCValues gc_values
;
3756 /* Create the GC's of this frame.
3757 Note that many default values are used. */
3760 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3761 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3762 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3763 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3764 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3766 GCLineWidth
| GCFont
3767 | GCForeground
| GCBackground
,
3770 /* Reverse video style. */
3771 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3772 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3773 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3775 GCFont
| GCForeground
| GCBackground
3779 /* Cursor has cursor-color background, background-color foreground. */
3780 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3781 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3782 gc_values
.fill_style
= FillOpaqueStippled
;
3784 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3785 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3786 cursor_bits
, 16, 16);
3787 f
->output_data
.x
->cursor_gc
3788 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3789 (GCFont
| GCForeground
| GCBackground
3790 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3794 f
->output_data
.x
->white_relief
.gc
= 0;
3795 f
->output_data
.x
->black_relief
.gc
= 0;
3797 /* Create the gray border tile used when the pointer is not in
3798 the frame. Since this depends on the frame's pixel values,
3799 this must be done on a per-frame basis. */
3800 f
->output_data
.x
->border_tile
3801 = (XCreatePixmapFromBitmapData
3802 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3803 gray_bits
, gray_width
, gray_height
,
3804 f
->output_data
.x
->foreground_pixel
,
3805 f
->output_data
.x
->background_pixel
,
3806 DefaultDepth (FRAME_X_DISPLAY (f
),
3807 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3812 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3814 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3815 Returns an Emacs frame object.\n\
3816 ALIST is an alist of frame parameters.\n\
3817 If the parameters specify that the frame should not have a minibuffer,\n\
3818 and do not specify a specific minibuffer window to use,\n\
3819 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3820 be shared by the new frame.\n\
3822 This function is an internal primitive--use `make-frame' instead.")
3827 Lisp_Object frame
, tem
;
3829 int minibuffer_only
= 0;
3830 long window_prompting
= 0;
3832 int count
= specpdl_ptr
- specpdl
;
3833 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3834 Lisp_Object display
;
3835 struct x_display_info
*dpyinfo
= NULL
;
3841 /* Use this general default value to start with
3842 until we know if this frame has a specified name. */
3843 Vx_resource_name
= Vinvocation_name
;
3845 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3846 if (EQ (display
, Qunbound
))
3848 dpyinfo
= check_x_display_info (display
);
3850 kb
= dpyinfo
->kboard
;
3852 kb
= &the_only_kboard
;
3855 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3857 && ! EQ (name
, Qunbound
)
3859 error ("Invalid frame name--not a string or nil");
3862 Vx_resource_name
= name
;
3864 /* See if parent window is specified. */
3865 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3866 if (EQ (parent
, Qunbound
))
3868 if (! NILP (parent
))
3869 CHECK_NUMBER (parent
, 0);
3871 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3872 /* No need to protect DISPLAY because that's not used after passing
3873 it to make_frame_without_minibuffer. */
3875 GCPRO4 (parms
, parent
, name
, frame
);
3876 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3878 if (EQ (tem
, Qnone
) || NILP (tem
))
3879 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3880 else if (EQ (tem
, Qonly
))
3882 f
= make_minibuffer_frame ();
3883 minibuffer_only
= 1;
3885 else if (WINDOWP (tem
))
3886 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3890 XSETFRAME (frame
, f
);
3892 /* Note that X Windows does support scroll bars. */
3893 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3895 f
->output_method
= output_x_window
;
3896 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3897 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3898 f
->output_data
.x
->icon_bitmap
= -1;
3899 f
->output_data
.x
->fontset
= -1;
3900 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3901 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3904 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3906 if (! STRINGP (f
->icon_name
))
3907 f
->icon_name
= Qnil
;
3909 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3911 FRAME_KBOARD (f
) = kb
;
3914 /* These colors will be set anyway later, but it's important
3915 to get the color reference counts right, so initialize them! */
3918 struct gcpro gcpro1
;
3920 black
= build_string ("black");
3922 f
->output_data
.x
->foreground_pixel
3923 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3924 f
->output_data
.x
->background_pixel
3925 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3926 f
->output_data
.x
->cursor_pixel
3927 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3928 f
->output_data
.x
->cursor_foreground_pixel
3929 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3930 f
->output_data
.x
->border_pixel
3931 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3932 f
->output_data
.x
->mouse_pixel
3933 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
3937 /* Specify the parent under which to make this X window. */
3941 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3942 f
->output_data
.x
->explicit_parent
= 1;
3946 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3947 f
->output_data
.x
->explicit_parent
= 0;
3950 /* Set the name; the functions to which we pass f expect the name to
3952 if (EQ (name
, Qunbound
) || NILP (name
))
3954 f
->name
= build_string (dpyinfo
->x_id_name
);
3955 f
->explicit_name
= 0;
3960 f
->explicit_name
= 1;
3961 /* use the frame's title when getting resources for this frame. */
3962 specbind (Qx_resource_name
, name
);
3965 /* Extract the window parameters from the supplied values
3966 that are needed to determine window geometry. */
3970 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3973 /* First, try whatever font the caller has specified. */
3976 tem
= Fquery_fontset (font
, Qnil
);
3978 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3980 font
= x_new_font (f
, XSTRING (font
)->data
);
3983 /* Try out a font which we hope has bold and italic variations. */
3984 if (!STRINGP (font
))
3985 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3986 if (!STRINGP (font
))
3987 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3988 if (! STRINGP (font
))
3989 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3990 if (! STRINGP (font
))
3991 /* This was formerly the first thing tried, but it finds too many fonts
3992 and takes too long. */
3993 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3994 /* If those didn't work, look for something which will at least work. */
3995 if (! STRINGP (font
))
3996 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3998 if (! STRINGP (font
))
3999 font
= build_string ("fixed");
4001 x_default_parameter (f
, parms
, Qfont
, font
,
4002 "font", "Font", RES_TYPE_STRING
);
4006 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4007 whereby it fails to get any font. */
4008 xlwmenu_default_font
= f
->output_data
.x
->font
;
4011 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4012 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4014 /* This defaults to 2 in order to match xterm. We recognize either
4015 internalBorderWidth or internalBorder (which is what xterm calls
4017 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4021 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4022 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4023 if (! EQ (value
, Qunbound
))
4024 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4027 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4028 "internalBorderWidth", "internalBorderWidth",
4030 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4031 "verticalScrollBars", "ScrollBars",
4034 /* Also do the stuff which must be set before the window exists. */
4035 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4036 "foreground", "Foreground", RES_TYPE_STRING
);
4037 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4038 "background", "Background", RES_TYPE_STRING
);
4039 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4040 "pointerColor", "Foreground", RES_TYPE_STRING
);
4041 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4042 "cursorColor", "Foreground", RES_TYPE_STRING
);
4043 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4044 "borderColor", "BorderColor", RES_TYPE_STRING
);
4045 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4046 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4047 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4048 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4050 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4051 "scrollBarForeground",
4052 "ScrollBarForeground", 1);
4053 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4054 "scrollBarBackground",
4055 "ScrollBarBackground", 0);
4057 /* Init faces before x_default_parameter is called for scroll-bar
4058 parameters because that function calls x_set_scroll_bar_width,
4059 which calls change_frame_size, which calls Fset_window_buffer,
4060 which runs hooks, which call Fvertical_motion. At the end, we
4061 end up in init_iterator with a null face cache, which should not
4063 init_frame_faces (f
);
4065 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4066 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4067 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4068 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4069 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4070 "bufferPredicate", "BufferPredicate",
4072 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4073 "title", "Title", RES_TYPE_STRING
);
4075 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4076 window_prompting
= x_figure_window_size (f
, parms
);
4078 if (window_prompting
& XNegative
)
4080 if (window_prompting
& YNegative
)
4081 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4083 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4087 if (window_prompting
& YNegative
)
4088 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4090 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4093 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4095 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4096 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4098 /* Create the X widget or window. Add the tool-bar height to the
4099 initial frame height so that the user gets a text display area of
4100 the size he specified with -g or via .Xdefaults. Later changes
4101 of the tool-bar height don't change the frame size. This is done
4102 so that users can create tall Emacs frames without having to
4103 guess how tall the tool-bar will get. */
4104 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4106 #ifdef USE_X_TOOLKIT
4107 x_window (f
, window_prompting
, minibuffer_only
);
4115 /* Now consider the frame official. */
4116 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4117 Vframe_list
= Fcons (frame
, Vframe_list
);
4119 /* We need to do this after creating the X window, so that the
4120 icon-creation functions can say whose icon they're describing. */
4121 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4122 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4124 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4125 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4126 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4127 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4128 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4129 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4130 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4131 "scrollBarWidth", "ScrollBarWidth",
4134 /* Dimensions, especially f->height, must be done via change_frame_size.
4135 Change will not be effected unless different from the current
4140 SET_FRAME_WIDTH (f
, 0);
4141 change_frame_size (f
, height
, width
, 1, 0, 0);
4143 /* Set up faces after all frame parameters are known. */
4144 call1 (Qface_set_after_frame_default
, frame
);
4146 #ifdef USE_X_TOOLKIT
4147 /* Create the menu bar. */
4148 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4150 /* If this signals an error, we haven't set size hints for the
4151 frame and we didn't make it visible. */
4152 initialize_frame_menubar (f
);
4154 /* This is a no-op, except under Motif where it arranges the
4155 main window for the widgets on it. */
4156 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4157 f
->output_data
.x
->menubar_widget
,
4158 f
->output_data
.x
->edit_widget
);
4160 #endif /* USE_X_TOOLKIT */
4162 /* Tell the server what size and position, etc, we want, and how
4163 badly we want them. This should be done after we have the menu
4164 bar so that its size can be taken into account. */
4166 x_wm_set_size_hint (f
, window_prompting
, 0);
4169 /* Make the window appear on the frame and enable display, unless
4170 the caller says not to. However, with explicit parent, Emacs
4171 cannot control visibility, so don't try. */
4172 if (! f
->output_data
.x
->explicit_parent
)
4174 Lisp_Object visibility
;
4176 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4178 if (EQ (visibility
, Qunbound
))
4181 if (EQ (visibility
, Qicon
))
4182 x_iconify_frame (f
);
4183 else if (! NILP (visibility
))
4184 x_make_frame_visible (f
);
4186 /* Must have been Qnil. */
4191 return unbind_to (count
, frame
);
4194 /* FRAME is used only to get a handle on the X display. We don't pass the
4195 display info directly because we're called from frame.c, which doesn't
4196 know about that structure. */
4199 x_get_focus_frame (frame
)
4200 struct frame
*frame
;
4202 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4204 if (! dpyinfo
->x_focus_frame
)
4207 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4212 /* In certain situations, when the window manager follows a
4213 click-to-focus policy, there seems to be no way around calling
4214 XSetInputFocus to give another frame the input focus .
4216 In an ideal world, XSetInputFocus should generally be avoided so
4217 that applications don't interfere with the window manager's focus
4218 policy. But I think it's okay to use when it's clearly done
4219 following a user-command. */
4221 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4222 "Set the input focus to FRAME.\n\
4223 FRAME nil means use the selected frame.")
4227 struct frame
*f
= check_x_frame (frame
);
4228 Display
*dpy
= FRAME_X_DISPLAY (f
);
4232 count
= x_catch_errors (dpy
);
4233 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4234 RevertToParent
, CurrentTime
);
4235 x_uncatch_errors (dpy
, count
);
4242 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4243 "Internal function called by `color-defined-p', which see.")
4245 Lisp_Object color
, frame
;
4248 FRAME_PTR f
= check_x_frame (frame
);
4250 CHECK_STRING (color
, 1);
4252 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4258 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4259 "Internal function called by `color-values', which see.")
4261 Lisp_Object color
, frame
;
4264 FRAME_PTR f
= check_x_frame (frame
);
4266 CHECK_STRING (color
, 1);
4268 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4272 rgb
[0] = make_number (foo
.red
);
4273 rgb
[1] = make_number (foo
.green
);
4274 rgb
[2] = make_number (foo
.blue
);
4275 return Flist (3, rgb
);
4281 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4282 "Internal function called by `display-color-p', which see.")
4284 Lisp_Object display
;
4286 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4288 if (dpyinfo
->n_planes
<= 2)
4291 switch (dpyinfo
->visual
->class)
4304 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4306 "Return t if the X display supports shades of gray.\n\
4307 Note that color displays do support shades of gray.\n\
4308 The optional argument DISPLAY specifies which display to ask about.\n\
4309 DISPLAY should be either a frame or a display name (a string).\n\
4310 If omitted or nil, that stands for the selected frame's display.")
4312 Lisp_Object display
;
4314 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4316 if (dpyinfo
->n_planes
<= 1)
4319 switch (dpyinfo
->visual
->class)
4334 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4336 "Returns the width in pixels of the X display DISPLAY.\n\
4337 The optional argument DISPLAY specifies which display to ask about.\n\
4338 DISPLAY should be either a frame or a display name (a string).\n\
4339 If omitted or nil, that stands for the selected frame's display.")
4341 Lisp_Object display
;
4343 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4345 return make_number (dpyinfo
->width
);
4348 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4349 Sx_display_pixel_height
, 0, 1, 0,
4350 "Returns the height in pixels of the X display DISPLAY.\n\
4351 The optional argument DISPLAY specifies which display to ask about.\n\
4352 DISPLAY should be either a frame or a display name (a string).\n\
4353 If omitted or nil, that stands for the selected frame's display.")
4355 Lisp_Object display
;
4357 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4359 return make_number (dpyinfo
->height
);
4362 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4364 "Returns the number of bitplanes of the X display DISPLAY.\n\
4365 The optional argument DISPLAY specifies which display to ask about.\n\
4366 DISPLAY should be either a frame or a display name (a string).\n\
4367 If omitted or nil, that stands for the selected frame's display.")
4369 Lisp_Object display
;
4371 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4373 return make_number (dpyinfo
->n_planes
);
4376 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4378 "Returns the number of color cells of the X display DISPLAY.\n\
4379 The optional argument DISPLAY specifies which display to ask about.\n\
4380 DISPLAY should be either a frame or a display name (a string).\n\
4381 If omitted or nil, that stands for the selected frame's display.")
4383 Lisp_Object display
;
4385 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4387 return make_number (DisplayCells (dpyinfo
->display
,
4388 XScreenNumberOfScreen (dpyinfo
->screen
)));
4391 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4392 Sx_server_max_request_size
,
4394 "Returns the maximum request size of the X server of display DISPLAY.\n\
4395 The optional argument DISPLAY specifies which display to ask about.\n\
4396 DISPLAY should be either a frame or a display name (a string).\n\
4397 If omitted or nil, that stands for the selected frame's display.")
4399 Lisp_Object display
;
4401 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4403 return make_number (MAXREQUEST (dpyinfo
->display
));
4406 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4407 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4408 The optional argument DISPLAY specifies which display to ask about.\n\
4409 DISPLAY should be either a frame or a display name (a string).\n\
4410 If omitted or nil, that stands for the selected frame's display.")
4412 Lisp_Object display
;
4414 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4415 char *vendor
= ServerVendor (dpyinfo
->display
);
4417 if (! vendor
) vendor
= "";
4418 return build_string (vendor
);
4421 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4422 "Returns the version numbers of the X server of display DISPLAY.\n\
4423 The value is a list of three integers: the major and minor\n\
4424 version numbers of the X Protocol in use, and the vendor-specific release\n\
4425 number. See also the function `x-server-vendor'.\n\n\
4426 The optional argument DISPLAY specifies which display to ask about.\n\
4427 DISPLAY should be either a frame or a display name (a string).\n\
4428 If omitted or nil, that stands for the selected frame's display.")
4430 Lisp_Object display
;
4432 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4433 Display
*dpy
= dpyinfo
->display
;
4435 return Fcons (make_number (ProtocolVersion (dpy
)),
4436 Fcons (make_number (ProtocolRevision (dpy
)),
4437 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4440 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4441 "Returns the number of screens on the X server of display DISPLAY.\n\
4442 The optional argument DISPLAY specifies which display to ask about.\n\
4443 DISPLAY should be either a frame or a display name (a string).\n\
4444 If omitted or nil, that stands for the selected frame's display.")
4446 Lisp_Object display
;
4448 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4450 return make_number (ScreenCount (dpyinfo
->display
));
4453 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4454 "Returns the height in millimeters of the X display DISPLAY.\n\
4455 The optional argument DISPLAY specifies which display to ask about.\n\
4456 DISPLAY should be either a frame or a display name (a string).\n\
4457 If omitted or nil, that stands for the selected frame's display.")
4459 Lisp_Object display
;
4461 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4463 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4466 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4467 "Returns the width in millimeters of the X display DISPLAY.\n\
4468 The optional argument DISPLAY specifies which display to ask about.\n\
4469 DISPLAY should be either a frame or a display name (a string).\n\
4470 If omitted or nil, that stands for the selected frame's display.")
4472 Lisp_Object display
;
4474 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4476 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4479 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4480 Sx_display_backing_store
, 0, 1, 0,
4481 "Returns an indication of whether X display DISPLAY does backing store.\n\
4482 The value may be `always', `when-mapped', or `not-useful'.\n\
4483 The optional argument DISPLAY specifies which display to ask about.\n\
4484 DISPLAY should be either a frame or a display name (a string).\n\
4485 If omitted or nil, that stands for the selected frame's display.")
4487 Lisp_Object display
;
4489 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4491 switch (DoesBackingStore (dpyinfo
->screen
))
4494 return intern ("always");
4497 return intern ("when-mapped");
4500 return intern ("not-useful");
4503 error ("Strange value for BackingStore parameter of screen");
4507 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4508 Sx_display_visual_class
, 0, 1, 0,
4509 "Returns the visual class of the X display DISPLAY.\n\
4510 The value is one of the symbols `static-gray', `gray-scale',\n\
4511 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4512 The optional argument DISPLAY specifies which display to ask about.\n\
4513 DISPLAY should be either a frame or a display name (a string).\n\
4514 If omitted or nil, that stands for the selected frame's display.")
4516 Lisp_Object display
;
4518 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4520 switch (dpyinfo
->visual
->class)
4522 case StaticGray
: return (intern ("static-gray"));
4523 case GrayScale
: return (intern ("gray-scale"));
4524 case StaticColor
: return (intern ("static-color"));
4525 case PseudoColor
: return (intern ("pseudo-color"));
4526 case TrueColor
: return (intern ("true-color"));
4527 case DirectColor
: return (intern ("direct-color"));
4529 error ("Display has an unknown visual class");
4533 DEFUN ("x-display-save-under", Fx_display_save_under
,
4534 Sx_display_save_under
, 0, 1, 0,
4535 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4536 The optional argument DISPLAY specifies which display to ask about.\n\
4537 DISPLAY should be either a frame or a display name (a string).\n\
4538 If omitted or nil, that stands for the selected frame's display.")
4540 Lisp_Object display
;
4542 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4544 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4552 register struct frame
*f
;
4554 return PIXEL_WIDTH (f
);
4559 register struct frame
*f
;
4561 return PIXEL_HEIGHT (f
);
4566 register struct frame
*f
;
4568 return FONT_WIDTH (f
->output_data
.x
->font
);
4573 register struct frame
*f
;
4575 return f
->output_data
.x
->line_height
;
4580 register struct frame
*f
;
4582 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4587 /************************************************************************
4589 ************************************************************************/
4592 /* Mapping visual names to visuals. */
4594 static struct visual_class
4601 {"StaticGray", StaticGray
},
4602 {"GrayScale", GrayScale
},
4603 {"StaticColor", StaticColor
},
4604 {"PseudoColor", PseudoColor
},
4605 {"TrueColor", TrueColor
},
4606 {"DirectColor", DirectColor
},
4611 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4613 /* Value is the screen number of screen SCR. This is a substitute for
4614 the X function with the same name when that doesn't exist. */
4617 XScreenNumberOfScreen (scr
)
4618 register Screen
*scr
;
4620 Display
*dpy
= scr
->display
;
4623 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4624 if (scr
== dpy
->screens
[i
])
4630 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4633 /* Select the visual that should be used on display DPYINFO. Set
4634 members of DPYINFO appropriately. Called from x_term_init. */
4637 select_visual (dpyinfo
)
4638 struct x_display_info
*dpyinfo
;
4640 Display
*dpy
= dpyinfo
->display
;
4641 Screen
*screen
= dpyinfo
->screen
;
4644 /* See if a visual is specified. */
4645 value
= display_x_get_resource (dpyinfo
,
4646 build_string ("visualClass"),
4647 build_string ("VisualClass"),
4649 if (STRINGP (value
))
4651 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4652 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4653 depth, a decimal number. NAME is compared with case ignored. */
4654 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4659 strcpy (s
, XSTRING (value
)->data
);
4660 dash
= index (s
, '-');
4663 dpyinfo
->n_planes
= atoi (dash
+ 1);
4667 /* We won't find a matching visual with depth 0, so that
4668 an error will be printed below. */
4669 dpyinfo
->n_planes
= 0;
4671 /* Determine the visual class. */
4672 for (i
= 0; visual_classes
[i
].name
; ++i
)
4673 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4675 class = visual_classes
[i
].class;
4679 /* Look up a matching visual for the specified class. */
4681 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4682 dpyinfo
->n_planes
, class, &vinfo
))
4683 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4685 dpyinfo
->visual
= vinfo
.visual
;
4690 XVisualInfo
*vinfo
, vinfo_template
;
4692 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4695 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4697 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4699 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4700 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4701 &vinfo_template
, &n_visuals
);
4703 fatal ("Can't get proper X visual info");
4705 dpyinfo
->n_planes
= vinfo
->depth
;
4706 XFree ((char *) vinfo
);
4711 /* Return the X display structure for the display named NAME.
4712 Open a new connection if necessary. */
4714 struct x_display_info
*
4715 x_display_info_for_name (name
)
4719 struct x_display_info
*dpyinfo
;
4721 CHECK_STRING (name
, 0);
4723 if (! EQ (Vwindow_system
, intern ("x")))
4724 error ("Not using X Windows");
4726 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4728 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4731 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4736 /* Use this general default value to start with. */
4737 Vx_resource_name
= Vinvocation_name
;
4739 validate_x_resource_name ();
4741 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4742 (char *) XSTRING (Vx_resource_name
)->data
);
4745 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4748 XSETFASTINT (Vwindow_system_version
, 11);
4754 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4755 1, 3, 0, "Open a connection to an X server.\n\
4756 DISPLAY is the name of the display to connect to.\n\
4757 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4758 If the optional third arg MUST-SUCCEED is non-nil,\n\
4759 terminate Emacs if we can't open the connection.")
4760 (display
, xrm_string
, must_succeed
)
4761 Lisp_Object display
, xrm_string
, must_succeed
;
4763 unsigned char *xrm_option
;
4764 struct x_display_info
*dpyinfo
;
4766 CHECK_STRING (display
, 0);
4767 if (! NILP (xrm_string
))
4768 CHECK_STRING (xrm_string
, 1);
4770 if (! EQ (Vwindow_system
, intern ("x")))
4771 error ("Not using X Windows");
4773 if (! NILP (xrm_string
))
4774 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4776 xrm_option
= (unsigned char *) 0;
4778 validate_x_resource_name ();
4780 /* This is what opens the connection and sets x_current_display.
4781 This also initializes many symbols, such as those used for input. */
4782 dpyinfo
= x_term_init (display
, xrm_option
,
4783 (char *) XSTRING (Vx_resource_name
)->data
);
4787 if (!NILP (must_succeed
))
4788 fatal ("Cannot connect to X server %s.\n\
4789 Check the DISPLAY environment variable or use `-d'.\n\
4790 Also use the `xhost' program to verify that it is set to permit\n\
4791 connections from your machine.\n",
4792 XSTRING (display
)->data
);
4794 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4799 XSETFASTINT (Vwindow_system_version
, 11);
4803 DEFUN ("x-close-connection", Fx_close_connection
,
4804 Sx_close_connection
, 1, 1, 0,
4805 "Close the connection to DISPLAY's X server.\n\
4806 For DISPLAY, specify either a frame or a display name (a string).\n\
4807 If DISPLAY is nil, that stands for the selected frame's display.")
4809 Lisp_Object display
;
4811 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4814 if (dpyinfo
->reference_count
> 0)
4815 error ("Display still has frames on it");
4818 /* Free the fonts in the font table. */
4819 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4820 if (dpyinfo
->font_table
[i
].name
)
4822 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4823 xfree (dpyinfo
->font_table
[i
].full_name
);
4824 xfree (dpyinfo
->font_table
[i
].name
);
4825 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4828 x_destroy_all_bitmaps (dpyinfo
);
4829 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4831 #ifdef USE_X_TOOLKIT
4832 XtCloseDisplay (dpyinfo
->display
);
4834 XCloseDisplay (dpyinfo
->display
);
4837 x_delete_display (dpyinfo
);
4843 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4844 "Return the list of display names that Emacs has connections to.")
4847 Lisp_Object tail
, result
;
4850 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4851 result
= Fcons (XCAR (XCAR (tail
)), result
);
4856 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4857 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4858 If ON is nil, allow buffering of requests.\n\
4859 Turning on synchronization prohibits the Xlib routines from buffering\n\
4860 requests and seriously degrades performance, but makes debugging much\n\
4862 The optional second argument DISPLAY specifies which display to act on.\n\
4863 DISPLAY should be either a frame or a display name (a string).\n\
4864 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4866 Lisp_Object display
, on
;
4868 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4870 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4875 /* Wait for responses to all X commands issued so far for frame F. */
4882 XSync (FRAME_X_DISPLAY (f
), False
);
4887 /***********************************************************************
4889 ***********************************************************************/
4891 /* Value is the number of elements of vector VECTOR. */
4893 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
4895 /* List of supported image types. Use define_image_type to add new
4896 types. Use lookup_image_type to find a type for a given symbol. */
4898 static struct image_type
*image_types
;
4900 /* The symbol `image' which is the car of the lists used to represent
4903 extern Lisp_Object Qimage
;
4905 /* The symbol `xbm' which is used as the type symbol for XBM images. */
4911 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
4912 extern Lisp_Object QCdata
;
4913 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
4914 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
4915 Lisp_Object QCindex
;
4917 /* Other symbols. */
4919 Lisp_Object Qlaplace
;
4921 /* Time in seconds after which images should be removed from the cache
4922 if not displayed. */
4924 Lisp_Object Vimage_cache_eviction_delay
;
4926 /* Function prototypes. */
4928 static void define_image_type
P_ ((struct image_type
*type
));
4929 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
4930 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
4931 static void x_laplace
P_ ((struct frame
*, struct image
*));
4932 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
4936 /* Define a new image type from TYPE. This adds a copy of TYPE to
4937 image_types and adds the symbol *TYPE->type to Vimage_types. */
4940 define_image_type (type
)
4941 struct image_type
*type
;
4943 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
4944 The initialized data segment is read-only. */
4945 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
4946 bcopy (type
, p
, sizeof *p
);
4947 p
->next
= image_types
;
4949 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
4953 /* Look up image type SYMBOL, and return a pointer to its image_type
4954 structure. Value is null if SYMBOL is not a known image type. */
4956 static INLINE
struct image_type
*
4957 lookup_image_type (symbol
)
4960 struct image_type
*type
;
4962 for (type
= image_types
; type
; type
= type
->next
)
4963 if (EQ (symbol
, *type
->type
))
4970 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
4971 valid image specification is a list whose car is the symbol
4972 `image', and whose rest is a property list. The property list must
4973 contain a value for key `:type'. That value must be the name of a
4974 supported image type. The rest of the property list depends on the
4978 valid_image_p (object
)
4983 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
4985 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
4986 struct image_type
*type
= lookup_image_type (symbol
);
4989 valid_p
= type
->valid_p (object
);
4996 /* Log error message with format string FORMAT and argument ARG.
4997 Signaling an error, e.g. when an image cannot be loaded, is not a
4998 good idea because this would interrupt redisplay, and the error
4999 message display would lead to another redisplay. This function
5000 therefore simply displays a message. */
5003 image_error (format
, arg1
, arg2
)
5005 Lisp_Object arg1
, arg2
;
5007 add_to_log (format
, arg1
, arg2
);
5012 /***********************************************************************
5013 Image specifications
5014 ***********************************************************************/
5016 enum image_value_type
5018 IMAGE_DONT_CHECK_VALUE_TYPE
,
5021 IMAGE_POSITIVE_INTEGER_VALUE
,
5022 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5024 IMAGE_INTEGER_VALUE
,
5025 IMAGE_FUNCTION_VALUE
,
5030 /* Structure used when parsing image specifications. */
5032 struct image_keyword
5034 /* Name of keyword. */
5037 /* The type of value allowed. */
5038 enum image_value_type type
;
5040 /* Non-zero means key must be present. */
5043 /* Used to recognize duplicate keywords in a property list. */
5046 /* The value that was found. */
5051 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5053 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5056 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5057 has the format (image KEYWORD VALUE ...). One of the keyword/
5058 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5059 image_keywords structures of size NKEYWORDS describing other
5060 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5063 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5065 struct image_keyword
*keywords
;
5072 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5075 plist
= XCDR (spec
);
5076 while (CONSP (plist
))
5078 Lisp_Object key
, value
;
5080 /* First element of a pair must be a symbol. */
5082 plist
= XCDR (plist
);
5086 /* There must follow a value. */
5089 value
= XCAR (plist
);
5090 plist
= XCDR (plist
);
5092 /* Find key in KEYWORDS. Error if not found. */
5093 for (i
= 0; i
< nkeywords
; ++i
)
5094 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5100 /* Record that we recognized the keyword. If a keywords
5101 was found more than once, it's an error. */
5102 keywords
[i
].value
= value
;
5103 ++keywords
[i
].count
;
5105 if (keywords
[i
].count
> 1)
5108 /* Check type of value against allowed type. */
5109 switch (keywords
[i
].type
)
5111 case IMAGE_STRING_VALUE
:
5112 if (!STRINGP (value
))
5116 case IMAGE_SYMBOL_VALUE
:
5117 if (!SYMBOLP (value
))
5121 case IMAGE_POSITIVE_INTEGER_VALUE
:
5122 if (!INTEGERP (value
) || XINT (value
) <= 0)
5126 case IMAGE_ASCENT_VALUE
:
5127 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5129 else if (INTEGERP (value
)
5130 && XINT (value
) >= 0
5131 && XINT (value
) <= 100)
5135 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5136 if (!INTEGERP (value
) || XINT (value
) < 0)
5140 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5143 case IMAGE_FUNCTION_VALUE
:
5144 value
= indirect_function (value
);
5146 || COMPILEDP (value
)
5147 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5151 case IMAGE_NUMBER_VALUE
:
5152 if (!INTEGERP (value
) && !FLOATP (value
))
5156 case IMAGE_INTEGER_VALUE
:
5157 if (!INTEGERP (value
))
5161 case IMAGE_BOOL_VALUE
:
5162 if (!NILP (value
) && !EQ (value
, Qt
))
5171 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5175 /* Check that all mandatory fields are present. */
5176 for (i
= 0; i
< nkeywords
; ++i
)
5177 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5180 return NILP (plist
);
5184 /* Return the value of KEY in image specification SPEC. Value is nil
5185 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5186 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5189 image_spec_value (spec
, key
, found
)
5190 Lisp_Object spec
, key
;
5195 xassert (valid_image_p (spec
));
5197 for (tail
= XCDR (spec
);
5198 CONSP (tail
) && CONSP (XCDR (tail
));
5199 tail
= XCDR (XCDR (tail
)))
5201 if (EQ (XCAR (tail
), key
))
5205 return XCAR (XCDR (tail
));
5217 /***********************************************************************
5218 Image type independent image structures
5219 ***********************************************************************/
5221 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5222 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5225 /* Allocate and return a new image structure for image specification
5226 SPEC. SPEC has a hash value of HASH. */
5228 static struct image
*
5229 make_image (spec
, hash
)
5233 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5235 xassert (valid_image_p (spec
));
5236 bzero (img
, sizeof *img
);
5237 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5238 xassert (img
->type
!= NULL
);
5240 img
->data
.lisp_val
= Qnil
;
5241 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5247 /* Free image IMG which was used on frame F, including its resources. */
5256 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5258 /* Remove IMG from the hash table of its cache. */
5260 img
->prev
->next
= img
->next
;
5262 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5265 img
->next
->prev
= img
->prev
;
5267 c
->images
[img
->id
] = NULL
;
5269 /* Free resources, then free IMG. */
5270 img
->type
->free (f
, img
);
5276 /* Prepare image IMG for display on frame F. Must be called before
5277 drawing an image. */
5280 prepare_image_for_display (f
, img
)
5286 /* We're about to display IMG, so set its timestamp to `now'. */
5288 img
->timestamp
= EMACS_SECS (t
);
5290 /* If IMG doesn't have a pixmap yet, load it now, using the image
5291 type dependent loader function. */
5292 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5293 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5297 /* Value is the number of pixels for the ascent of image IMG when
5298 drawn in face FACE. */
5301 image_ascent (img
, face
)
5305 int height
= img
->height
+ img
->margin
;
5308 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5311 ascent
= height
/ 2 - (face
->font
->descent
- face
->font
->ascent
) / 2;
5313 ascent
= height
/ 2;
5316 ascent
= height
* img
->ascent
/ 100.0;
5323 /***********************************************************************
5324 Helper functions for X image types
5325 ***********************************************************************/
5327 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5328 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5330 Lisp_Object color_name
,
5331 unsigned long dflt
));
5333 /* Free X resources of image IMG which is used on frame F. */
5336 x_clear_image (f
, img
)
5343 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5351 x_free_colors (f
, img
->colors
, img
->ncolors
);
5354 xfree (img
->colors
);
5361 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5362 cannot be allocated, use DFLT. Add a newly allocated color to
5363 IMG->colors, so that it can be freed again. Value is the pixel
5366 static unsigned long
5367 x_alloc_image_color (f
, img
, color_name
, dflt
)
5370 Lisp_Object color_name
;
5374 unsigned long result
;
5376 xassert (STRINGP (color_name
));
5378 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5380 /* This isn't called frequently so we get away with simply
5381 reallocating the color vector to the needed size, here. */
5384 (unsigned long *) xrealloc (img
->colors
,
5385 img
->ncolors
* sizeof *img
->colors
);
5386 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5387 result
= color
.pixel
;
5397 /***********************************************************************
5399 ***********************************************************************/
5401 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5404 /* Return a new, initialized image cache that is allocated from the
5405 heap. Call free_image_cache to free an image cache. */
5407 struct image_cache
*
5410 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5413 bzero (c
, sizeof *c
);
5415 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5416 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5417 c
->buckets
= (struct image
**) xmalloc (size
);
5418 bzero (c
->buckets
, size
);
5423 /* Free image cache of frame F. Be aware that X frames share images
5427 free_image_cache (f
)
5430 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5435 /* Cache should not be referenced by any frame when freed. */
5436 xassert (c
->refcount
== 0);
5438 for (i
= 0; i
< c
->used
; ++i
)
5439 free_image (f
, c
->images
[i
]);
5443 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5448 /* Clear image cache of frame F. FORCE_P non-zero means free all
5449 images. FORCE_P zero means clear only images that haven't been
5450 displayed for some time. Should be called from time to time to
5451 reduce the number of loaded images. If image-eviction-seconds is
5452 non-nil, this frees images in the cache which weren't displayed for
5453 at least that many seconds. */
5456 clear_image_cache (f
, force_p
)
5460 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5462 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5466 int i
, any_freed_p
= 0;
5469 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5471 for (i
= 0; i
< c
->used
; ++i
)
5473 struct image
*img
= c
->images
[i
];
5476 || (img
->timestamp
> old
)))
5478 free_image (f
, img
);
5483 /* We may be clearing the image cache because, for example,
5484 Emacs was iconified for a longer period of time. In that
5485 case, current matrices may still contain references to
5486 images freed above. So, clear these matrices. */
5489 clear_current_matrices (f
);
5490 ++windows_or_buffers_changed
;
5496 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5498 "Clear the image cache of FRAME.\n\
5499 FRAME nil or omitted means use the selected frame.\n\
5500 FRAME t means clear the image caches of all frames.")
5508 FOR_EACH_FRAME (tail
, frame
)
5509 if (FRAME_X_P (XFRAME (frame
)))
5510 clear_image_cache (XFRAME (frame
), 1);
5513 clear_image_cache (check_x_frame (frame
), 1);
5519 /* Return the id of image with Lisp specification SPEC on frame F.
5520 SPEC must be a valid Lisp image specification (see valid_image_p). */
5523 lookup_image (f
, spec
)
5527 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5531 struct gcpro gcpro1
;
5534 /* F must be a window-system frame, and SPEC must be a valid image
5536 xassert (FRAME_WINDOW_P (f
));
5537 xassert (valid_image_p (spec
));
5541 /* Look up SPEC in the hash table of the image cache. */
5542 hash
= sxhash (spec
, 0);
5543 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5545 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5546 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5549 /* If not found, create a new image and cache it. */
5552 img
= make_image (spec
, hash
);
5553 cache_image (f
, img
);
5554 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5555 xassert (!interrupt_input_blocked
);
5557 /* If we can't load the image, and we don't have a width and
5558 height, use some arbitrary width and height so that we can
5559 draw a rectangle for it. */
5560 if (img
->load_failed_p
)
5564 value
= image_spec_value (spec
, QCwidth
, NULL
);
5565 img
->width
= (INTEGERP (value
)
5566 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5567 value
= image_spec_value (spec
, QCheight
, NULL
);
5568 img
->height
= (INTEGERP (value
)
5569 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5573 /* Handle image type independent image attributes
5574 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5575 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
5578 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5579 if (INTEGERP (ascent
))
5580 img
->ascent
= XFASTINT (ascent
);
5581 else if (EQ (ascent
, Qcenter
))
5582 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5584 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5585 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5586 img
->margin
= XFASTINT (margin
);
5588 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5589 if (INTEGERP (relief
))
5591 img
->relief
= XINT (relief
);
5592 img
->margin
+= abs (img
->relief
);
5595 /* Should we apply a Laplace edge-detection algorithm? */
5596 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5597 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
5600 /* Should we built a mask heuristically? */
5601 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5602 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
5603 x_build_heuristic_mask (f
, img
, heuristic_mask
);
5607 /* We're using IMG, so set its timestamp to `now'. */
5608 EMACS_GET_TIME (now
);
5609 img
->timestamp
= EMACS_SECS (now
);
5613 /* Value is the image id. */
5618 /* Cache image IMG in the image cache of frame F. */
5621 cache_image (f
, img
)
5625 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5628 /* Find a free slot in c->images. */
5629 for (i
= 0; i
< c
->used
; ++i
)
5630 if (c
->images
[i
] == NULL
)
5633 /* If no free slot found, maybe enlarge c->images. */
5634 if (i
== c
->used
&& c
->used
== c
->size
)
5637 c
->images
= (struct image
**) xrealloc (c
->images
,
5638 c
->size
* sizeof *c
->images
);
5641 /* Add IMG to c->images, and assign IMG an id. */
5647 /* Add IMG to the cache's hash table. */
5648 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5649 img
->next
= c
->buckets
[i
];
5651 img
->next
->prev
= img
;
5653 c
->buckets
[i
] = img
;
5657 /* Call FN on every image in the image cache of frame F. Used to mark
5658 Lisp Objects in the image cache. */
5661 forall_images_in_image_cache (f
, fn
)
5663 void (*fn
) P_ ((struct image
*img
));
5665 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5667 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5671 for (i
= 0; i
< c
->used
; ++i
)
5680 /***********************************************************************
5682 ***********************************************************************/
5684 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5685 XImage
**, Pixmap
*));
5686 static void x_destroy_x_image
P_ ((XImage
*));
5687 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5690 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5691 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5692 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5693 via xmalloc. Print error messages via image_error if an error
5694 occurs. Value is non-zero if successful. */
5697 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5699 int width
, height
, depth
;
5703 Display
*display
= FRAME_X_DISPLAY (f
);
5704 Screen
*screen
= FRAME_X_SCREEN (f
);
5705 Window window
= FRAME_X_WINDOW (f
);
5707 xassert (interrupt_input_blocked
);
5710 depth
= DefaultDepthOfScreen (screen
);
5711 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5712 depth
, ZPixmap
, 0, NULL
, width
, height
,
5713 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5716 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5720 /* Allocate image raster. */
5721 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5723 /* Allocate a pixmap of the same size. */
5724 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5727 x_destroy_x_image (*ximg
);
5729 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
5737 /* Destroy XImage XIMG. Free XIMG->data. */
5740 x_destroy_x_image (ximg
)
5743 xassert (interrupt_input_blocked
);
5748 XDestroyImage (ximg
);
5753 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5754 are width and height of both the image and pixmap. */
5757 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
5764 xassert (interrupt_input_blocked
);
5765 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
5766 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
5767 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
5772 /***********************************************************************
5774 ***********************************************************************/
5776 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
5777 static char *slurp_file
P_ ((char *, int *));
5780 /* Find image file FILE. Look in data-directory, then
5781 x-bitmap-file-path. Value is the full name of the file found, or
5782 nil if not found. */
5785 x_find_image_file (file
)
5788 Lisp_Object file_found
, search_path
;
5789 struct gcpro gcpro1
, gcpro2
;
5793 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
5794 GCPRO2 (file_found
, search_path
);
5796 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
5797 fd
= openp (search_path
, file
, "", &file_found
, 0);
5809 /* Read FILE into memory. Value is a pointer to a buffer allocated
5810 with xmalloc holding FILE's contents. Value is null if an error
5811 occured. *SIZE is set to the size of the file. */
5814 slurp_file (file
, size
)
5822 if (stat (file
, &st
) == 0
5823 && (fp
= fopen (file
, "r")) != NULL
5824 && (buf
= (char *) xmalloc (st
.st_size
),
5825 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
5846 /***********************************************************************
5848 ***********************************************************************/
5850 static int xbm_scan
P_ ((char **, char *, char *, int *));
5851 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
5852 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
5854 static int xbm_image_p
P_ ((Lisp_Object object
));
5855 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
5857 static int xbm_file_p
P_ ((Lisp_Object
));
5860 /* Indices of image specification fields in xbm_format, below. */
5862 enum xbm_keyword_index
5879 /* Vector of image_keyword structures describing the format
5880 of valid XBM image specifications. */
5882 static struct image_keyword xbm_format
[XBM_LAST
] =
5884 {":type", IMAGE_SYMBOL_VALUE
, 1},
5885 {":file", IMAGE_STRING_VALUE
, 0},
5886 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5887 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5888 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5889 {":foreground", IMAGE_STRING_VALUE
, 0},
5890 {":background", IMAGE_STRING_VALUE
, 0},
5891 {":ascent", IMAGE_ASCENT_VALUE
, 0},
5892 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
5893 {":relief", IMAGE_INTEGER_VALUE
, 0},
5894 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
5895 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
5898 /* Structure describing the image type XBM. */
5900 static struct image_type xbm_type
=
5909 /* Tokens returned from xbm_scan. */
5918 /* Return non-zero if OBJECT is a valid XBM-type image specification.
5919 A valid specification is a list starting with the symbol `image'
5920 The rest of the list is a property list which must contain an
5923 If the specification specifies a file to load, it must contain
5924 an entry `:file FILENAME' where FILENAME is a string.
5926 If the specification is for a bitmap loaded from memory it must
5927 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
5928 WIDTH and HEIGHT are integers > 0. DATA may be:
5930 1. a string large enough to hold the bitmap data, i.e. it must
5931 have a size >= (WIDTH + 7) / 8 * HEIGHT
5933 2. a bool-vector of size >= WIDTH * HEIGHT
5935 3. a vector of strings or bool-vectors, one for each line of the
5938 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
5939 may not be specified in this case because they are defined in the
5942 Both the file and data forms may contain the additional entries
5943 `:background COLOR' and `:foreground COLOR'. If not present,
5944 foreground and background of the frame on which the image is
5945 displayed is used. */
5948 xbm_image_p (object
)
5951 struct image_keyword kw
[XBM_LAST
];
5953 bcopy (xbm_format
, kw
, sizeof kw
);
5954 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
5957 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
5959 if (kw
[XBM_FILE
].count
)
5961 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
5964 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
5966 /* In-memory XBM file. */
5967 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
5975 /* Entries for `:width', `:height' and `:data' must be present. */
5976 if (!kw
[XBM_WIDTH
].count
5977 || !kw
[XBM_HEIGHT
].count
5978 || !kw
[XBM_DATA
].count
)
5981 data
= kw
[XBM_DATA
].value
;
5982 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
5983 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
5985 /* Check type of data, and width and height against contents of
5991 /* Number of elements of the vector must be >= height. */
5992 if (XVECTOR (data
)->size
< height
)
5995 /* Each string or bool-vector in data must be large enough
5996 for one line of the image. */
5997 for (i
= 0; i
< height
; ++i
)
5999 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6003 if (XSTRING (elt
)->size
6004 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6007 else if (BOOL_VECTOR_P (elt
))
6009 if (XBOOL_VECTOR (elt
)->size
< width
)
6016 else if (STRINGP (data
))
6018 if (XSTRING (data
)->size
6019 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6022 else if (BOOL_VECTOR_P (data
))
6024 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6035 /* Scan a bitmap file. FP is the stream to read from. Value is
6036 either an enumerator from enum xbm_token, or a character for a
6037 single-character token, or 0 at end of file. If scanning an
6038 identifier, store the lexeme of the identifier in SVAL. If
6039 scanning a number, store its value in *IVAL. */
6042 xbm_scan (s
, end
, sval
, ival
)
6049 /* Skip white space. */
6050 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6055 else if (isdigit (c
))
6057 int value
= 0, digit
;
6059 if (c
== '0' && *s
< end
)
6062 if (c
== 'x' || c
== 'X')
6069 else if (c
>= 'a' && c
<= 'f')
6070 digit
= c
- 'a' + 10;
6071 else if (c
>= 'A' && c
<= 'F')
6072 digit
= c
- 'A' + 10;
6075 value
= 16 * value
+ digit
;
6078 else if (isdigit (c
))
6082 && (c
= *(*s
)++, isdigit (c
)))
6083 value
= 8 * value
+ c
- '0';
6090 && (c
= *(*s
)++, isdigit (c
)))
6091 value
= 10 * value
+ c
- '0';
6099 else if (isalpha (c
) || c
== '_')
6103 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6115 /* Replacement for XReadBitmapFileData which isn't available under old
6116 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6117 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6118 the image. Return in *DATA the bitmap data allocated with xmalloc.
6119 Value is non-zero if successful. DATA null means just test if
6120 CONTENTS looks like an im-memory XBM file. */
6123 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6124 char *contents
, *end
;
6125 int *width
, *height
;
6126 unsigned char **data
;
6129 char buffer
[BUFSIZ
];
6132 int bytes_per_line
, i
, nbytes
;
6138 LA1 = xbm_scan (&s, end, buffer, &value)
6140 #define expect(TOKEN) \
6141 if (LA1 != (TOKEN)) \
6146 #define expect_ident(IDENT) \
6147 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6152 *width
= *height
= -1;
6155 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6157 /* Parse defines for width, height and hot-spots. */
6161 expect_ident ("define");
6162 expect (XBM_TK_IDENT
);
6164 if (LA1
== XBM_TK_NUMBER
);
6166 char *p
= strrchr (buffer
, '_');
6167 p
= p
? p
+ 1 : buffer
;
6168 if (strcmp (p
, "width") == 0)
6170 else if (strcmp (p
, "height") == 0)
6173 expect (XBM_TK_NUMBER
);
6176 if (*width
< 0 || *height
< 0)
6178 else if (data
== NULL
)
6181 /* Parse bits. Must start with `static'. */
6182 expect_ident ("static");
6183 if (LA1
== XBM_TK_IDENT
)
6185 if (strcmp (buffer
, "unsigned") == 0)
6188 expect_ident ("char");
6190 else if (strcmp (buffer
, "short") == 0)
6194 if (*width
% 16 && *width
% 16 < 9)
6197 else if (strcmp (buffer
, "char") == 0)
6205 expect (XBM_TK_IDENT
);
6211 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6212 nbytes
= bytes_per_line
* *height
;
6213 p
= *data
= (char *) xmalloc (nbytes
);
6217 for (i
= 0; i
< nbytes
; i
+= 2)
6220 expect (XBM_TK_NUMBER
);
6223 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6226 if (LA1
== ',' || LA1
== '}')
6234 for (i
= 0; i
< nbytes
; ++i
)
6237 expect (XBM_TK_NUMBER
);
6241 if (LA1
== ',' || LA1
== '}')
6266 /* Load XBM image IMG which will be displayed on frame F from buffer
6267 CONTENTS. END is the end of the buffer. Value is non-zero if
6271 xbm_load_image (f
, img
, contents
, end
)
6274 char *contents
, *end
;
6277 unsigned char *data
;
6280 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6283 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6284 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6285 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6288 xassert (img
->width
> 0 && img
->height
> 0);
6290 /* Get foreground and background colors, maybe allocate colors. */
6291 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6293 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6295 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6297 background
= x_alloc_image_color (f
, img
, value
, background
);
6301 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6304 img
->width
, img
->height
,
6305 foreground
, background
,
6309 if (img
->pixmap
== 0)
6311 x_clear_image (f
, img
);
6312 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6320 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6326 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6333 return (STRINGP (data
)
6334 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6335 (XSTRING (data
)->data
6336 + STRING_BYTES (XSTRING (data
))),
6341 /* Fill image IMG which is used on frame F with pixmap data. Value is
6342 non-zero if successful. */
6350 Lisp_Object file_name
;
6352 xassert (xbm_image_p (img
->spec
));
6354 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6355 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6356 if (STRINGP (file_name
))
6361 struct gcpro gcpro1
;
6363 file
= x_find_image_file (file_name
);
6365 if (!STRINGP (file
))
6367 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6372 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6373 if (contents
== NULL
)
6375 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6380 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6385 struct image_keyword fmt
[XBM_LAST
];
6387 unsigned char *bitmap_data
;
6389 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6390 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6392 int parsed_p
, height
, width
;
6393 int in_memory_file_p
= 0;
6395 /* See if data looks like an in-memory XBM file. */
6396 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6397 in_memory_file_p
= xbm_file_p (data
);
6399 /* Parse the image specification. */
6400 bcopy (xbm_format
, fmt
, sizeof fmt
);
6401 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6404 /* Get specified width, and height. */
6405 if (!in_memory_file_p
)
6407 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6408 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6409 xassert (img
->width
> 0 && img
->height
> 0);
6414 /* Get foreground and background colors, maybe allocate colors. */
6415 if (fmt
[XBM_FOREGROUND
].count
)
6416 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6418 if (fmt
[XBM_BACKGROUND
].count
)
6419 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6422 if (in_memory_file_p
)
6423 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6424 (XSTRING (data
)->data
6425 + STRING_BYTES (XSTRING (data
))));
6432 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6434 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6435 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6437 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6439 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6441 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6444 else if (STRINGP (data
))
6445 bits
= XSTRING (data
)->data
;
6447 bits
= XBOOL_VECTOR (data
)->data
;
6449 /* Create the pixmap. */
6450 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6452 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6455 img
->width
, img
->height
,
6456 foreground
, background
,
6462 image_error ("Unable to create pixmap for XBM image `%s'",
6464 x_clear_image (f
, img
);
6476 /***********************************************************************
6478 ***********************************************************************/
6482 static int xpm_image_p
P_ ((Lisp_Object object
));
6483 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6484 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6486 #include "X11/xpm.h"
6488 /* The symbol `xpm' identifying XPM-format images. */
6492 /* Indices of image specification fields in xpm_format, below. */
6494 enum xpm_keyword_index
6508 /* Vector of image_keyword structures describing the format
6509 of valid XPM image specifications. */
6511 static struct image_keyword xpm_format
[XPM_LAST
] =
6513 {":type", IMAGE_SYMBOL_VALUE
, 1},
6514 {":file", IMAGE_STRING_VALUE
, 0},
6515 {":data", IMAGE_STRING_VALUE
, 0},
6516 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6517 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6518 {":relief", IMAGE_INTEGER_VALUE
, 0},
6519 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6520 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6521 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6524 /* Structure describing the image type XBM. */
6526 static struct image_type xpm_type
=
6536 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6537 for XPM images. Such a list must consist of conses whose car and
6541 xpm_valid_color_symbols_p (color_symbols
)
6542 Lisp_Object color_symbols
;
6544 while (CONSP (color_symbols
))
6546 Lisp_Object sym
= XCAR (color_symbols
);
6548 || !STRINGP (XCAR (sym
))
6549 || !STRINGP (XCDR (sym
)))
6551 color_symbols
= XCDR (color_symbols
);
6554 return NILP (color_symbols
);
6558 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6561 xpm_image_p (object
)
6564 struct image_keyword fmt
[XPM_LAST
];
6565 bcopy (xpm_format
, fmt
, sizeof fmt
);
6566 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6567 /* Either `:file' or `:data' must be present. */
6568 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6569 /* Either no `:color-symbols' or it's a list of conses
6570 whose car and cdr are strings. */
6571 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6572 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
6576 /* Load image IMG which will be displayed on frame F. Value is
6577 non-zero if successful. */
6585 XpmAttributes attrs
;
6586 Lisp_Object specified_file
, color_symbols
;
6588 /* Configure the XPM lib. Use the visual of frame F. Allocate
6589 close colors. Return colors allocated. */
6590 bzero (&attrs
, sizeof attrs
);
6591 attrs
.visual
= FRAME_X_VISUAL (f
);
6592 attrs
.colormap
= FRAME_X_COLORMAP (f
);
6593 attrs
.valuemask
|= XpmVisual
;
6594 attrs
.valuemask
|= XpmColormap
;
6595 attrs
.valuemask
|= XpmReturnAllocPixels
;
6596 #ifdef XpmAllocCloseColors
6597 attrs
.alloc_close_colors
= 1;
6598 attrs
.valuemask
|= XpmAllocCloseColors
;
6600 attrs
.closeness
= 600;
6601 attrs
.valuemask
|= XpmCloseness
;
6604 /* If image specification contains symbolic color definitions, add
6605 these to `attrs'. */
6606 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
6607 if (CONSP (color_symbols
))
6610 XpmColorSymbol
*xpm_syms
;
6613 attrs
.valuemask
|= XpmColorSymbols
;
6615 /* Count number of symbols. */
6616 attrs
.numsymbols
= 0;
6617 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
6620 /* Allocate an XpmColorSymbol array. */
6621 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
6622 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
6623 bzero (xpm_syms
, size
);
6624 attrs
.colorsymbols
= xpm_syms
;
6626 /* Fill the color symbol array. */
6627 for (tail
= color_symbols
, i
= 0;
6629 ++i
, tail
= XCDR (tail
))
6631 Lisp_Object name
= XCAR (XCAR (tail
));
6632 Lisp_Object color
= XCDR (XCAR (tail
));
6633 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
6634 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
6635 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
6636 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
6640 /* Create a pixmap for the image, either from a file, or from a
6641 string buffer containing data in the same format as an XPM file. */
6643 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6644 if (STRINGP (specified_file
))
6646 Lisp_Object file
= x_find_image_file (specified_file
);
6647 if (!STRINGP (file
))
6649 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6654 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6655 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
6660 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
6661 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6662 XSTRING (buffer
)->data
,
6663 &img
->pixmap
, &img
->mask
,
6668 if (rc
== XpmSuccess
)
6670 /* Remember allocated colors. */
6671 img
->ncolors
= attrs
.nalloc_pixels
;
6672 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
6673 * sizeof *img
->colors
);
6674 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
6676 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
6677 #ifdef DEBUG_X_COLORS
6678 register_color (img
->colors
[i
]);
6682 img
->width
= attrs
.width
;
6683 img
->height
= attrs
.height
;
6684 xassert (img
->width
> 0 && img
->height
> 0);
6686 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6688 XpmFreeAttributes (&attrs
);
6696 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
6699 case XpmFileInvalid
:
6700 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
6704 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
6707 case XpmColorFailed
:
6708 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
6712 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
6717 return rc
== XpmSuccess
;
6720 #endif /* HAVE_XPM != 0 */
6723 /***********************************************************************
6725 ***********************************************************************/
6727 /* An entry in the color table mapping an RGB color to a pixel color. */
6732 unsigned long pixel
;
6734 /* Next in color table collision list. */
6735 struct ct_color
*next
;
6738 /* The bucket vector size to use. Must be prime. */
6742 /* Value is a hash of the RGB color given by R, G, and B. */
6744 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6746 /* The color hash table. */
6748 struct ct_color
**ct_table
;
6750 /* Number of entries in the color table. */
6752 int ct_colors_allocated
;
6754 /* Function prototypes. */
6756 static void init_color_table
P_ ((void));
6757 static void free_color_table
P_ ((void));
6758 static unsigned long *colors_in_color_table
P_ ((int *n
));
6759 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
6760 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
6763 /* Initialize the color table. */
6768 int size
= CT_SIZE
* sizeof (*ct_table
);
6769 ct_table
= (struct ct_color
**) xmalloc (size
);
6770 bzero (ct_table
, size
);
6771 ct_colors_allocated
= 0;
6775 /* Free memory associated with the color table. */
6781 struct ct_color
*p
, *next
;
6783 for (i
= 0; i
< CT_SIZE
; ++i
)
6784 for (p
= ct_table
[i
]; p
; p
= next
)
6795 /* Value is a pixel color for RGB color R, G, B on frame F. If an
6796 entry for that color already is in the color table, return the
6797 pixel color of that entry. Otherwise, allocate a new color for R,
6798 G, B, and make an entry in the color table. */
6800 static unsigned long
6801 lookup_rgb_color (f
, r
, g
, b
)
6805 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
6806 int i
= hash
% CT_SIZE
;
6809 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6810 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
6824 cmap
= FRAME_X_COLORMAP (f
);
6825 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6830 ++ct_colors_allocated
;
6832 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6836 p
->pixel
= color
.pixel
;
6837 p
->next
= ct_table
[i
];
6841 return FRAME_FOREGROUND_PIXEL (f
);
6848 /* Look up pixel color PIXEL which is used on frame F in the color
6849 table. If not already present, allocate it. Value is PIXEL. */
6851 static unsigned long
6852 lookup_pixel_color (f
, pixel
)
6854 unsigned long pixel
;
6856 int i
= pixel
% CT_SIZE
;
6859 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6860 if (p
->pixel
== pixel
)
6871 cmap
= FRAME_X_COLORMAP (f
);
6872 color
.pixel
= pixel
;
6873 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
6874 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
6879 ++ct_colors_allocated
;
6881 p
= (struct ct_color
*) xmalloc (sizeof *p
);
6886 p
->next
= ct_table
[i
];
6890 return FRAME_FOREGROUND_PIXEL (f
);
6897 /* Value is a vector of all pixel colors contained in the color table,
6898 allocated via xmalloc. Set *N to the number of colors. */
6900 static unsigned long *
6901 colors_in_color_table (n
)
6906 unsigned long *colors
;
6908 if (ct_colors_allocated
== 0)
6915 colors
= (unsigned long *) xmalloc (ct_colors_allocated
6917 *n
= ct_colors_allocated
;
6919 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
6920 for (p
= ct_table
[i
]; p
; p
= p
->next
)
6921 colors
[j
++] = p
->pixel
;
6929 /***********************************************************************
6931 ***********************************************************************/
6933 static void x_laplace_write_row
P_ ((struct frame
*, long *,
6934 int, XImage
*, int));
6935 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
6936 XColor
*, int, XImage
*, int));
6939 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
6940 frame we operate on, CMAP is the color-map in effect, and WIDTH is
6941 the width of one row in the image. */
6944 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
6954 for (x
= 0; x
< width
; ++x
)
6955 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
6957 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
6961 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
6962 containing the pixel colors to write. F is the frame we are
6966 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
6975 for (x
= 0; x
< width
; ++x
)
6976 XPutPixel (ximg
, x
, y
, pixels
[x
]);
6980 /* Transform image IMG which is used on frame F with a Laplace
6981 edge-detection algorithm. The result is an image that can be used
6982 to draw disabled buttons, for example. */
6989 Colormap cmap
= FRAME_X_COLORMAP (f
);
6990 XImage
*ximg
, *oimg
;
6996 int in_y
, out_y
, rc
;
7001 /* Get the X image IMG->pixmap. */
7002 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7003 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7005 /* Allocate 3 input rows, and one output row of colors. */
7006 for (i
= 0; i
< 3; ++i
)
7007 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7008 out
= (long *) alloca (img
->width
* sizeof (long));
7010 /* Create an X image for output. */
7011 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7014 /* Fill first two rows. */
7015 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7016 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7019 /* Write first row, all zeros. */
7020 init_color_table ();
7021 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7022 for (x
= 0; x
< img
->width
; ++x
)
7024 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7027 for (y
= 2; y
< img
->height
; ++y
)
7030 int rowb
= (y
+ 2) % 3;
7032 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7034 for (x
= 0; x
< img
->width
- 2; ++x
)
7036 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7037 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7038 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7040 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7044 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7047 /* Write last line, all zeros. */
7048 for (x
= 0; x
< img
->width
; ++x
)
7050 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7052 /* Free the input image, and free resources of IMG. */
7053 XDestroyImage (ximg
);
7054 x_clear_image (f
, img
);
7056 /* Put the output image into pixmap, and destroy it. */
7057 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7058 x_destroy_x_image (oimg
);
7060 /* Remember new pixmap and colors in IMG. */
7061 img
->pixmap
= pixmap
;
7062 img
->colors
= colors_in_color_table (&img
->ncolors
);
7063 free_color_table ();
7069 /* Build a mask for image IMG which is used on frame F. FILE is the
7070 name of an image file, for error messages. HOW determines how to
7071 determine the background color of IMG. If it is a list '(R G B)',
7072 with R, G, and B being integers >= 0, take that as the color of the
7073 background. Otherwise, determine the background color of IMG
7074 heuristically. Value is non-zero if successful. */
7077 x_build_heuristic_mask (f
, img
, how
)
7082 Display
*dpy
= FRAME_X_DISPLAY (f
);
7083 XImage
*ximg
, *mask_img
;
7084 int x
, y
, rc
, look_at_corners_p
;
7089 /* Create an image and pixmap serving as mask. */
7090 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7091 &mask_img
, &img
->mask
);
7098 /* Get the X image of IMG->pixmap. */
7099 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7102 /* Determine the background color of ximg. If HOW is `(R G B)'
7103 take that as color. Otherwise, try to determine the color
7105 look_at_corners_p
= 1;
7113 && NATNUMP (XCAR (how
)))
7115 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7119 if (i
== 3 && NILP (how
))
7121 char color_name
[30];
7122 XColor exact
, color
;
7125 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7127 cmap
= FRAME_X_COLORMAP (f
);
7128 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7131 look_at_corners_p
= 0;
7136 if (look_at_corners_p
)
7138 unsigned long corners
[4];
7141 /* Get the colors at the corners of ximg. */
7142 corners
[0] = XGetPixel (ximg
, 0, 0);
7143 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7144 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7145 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7147 /* Choose the most frequently found color as background. */
7148 for (i
= best_count
= 0; i
< 4; ++i
)
7152 for (j
= n
= 0; j
< 4; ++j
)
7153 if (corners
[i
] == corners
[j
])
7157 bg
= corners
[i
], best_count
= n
;
7161 /* Set all bits in mask_img to 1 whose color in ximg is different
7162 from the background color bg. */
7163 for (y
= 0; y
< img
->height
; ++y
)
7164 for (x
= 0; x
< img
->width
; ++x
)
7165 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7167 /* Put mask_img into img->mask. */
7168 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7169 x_destroy_x_image (mask_img
);
7170 XDestroyImage (ximg
);
7178 /***********************************************************************
7179 PBM (mono, gray, color)
7180 ***********************************************************************/
7182 static int pbm_image_p
P_ ((Lisp_Object object
));
7183 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7184 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7186 /* The symbol `pbm' identifying images of this type. */
7190 /* Indices of image specification fields in gs_format, below. */
7192 enum pbm_keyword_index
7205 /* Vector of image_keyword structures describing the format
7206 of valid user-defined image specifications. */
7208 static struct image_keyword pbm_format
[PBM_LAST
] =
7210 {":type", IMAGE_SYMBOL_VALUE
, 1},
7211 {":file", IMAGE_STRING_VALUE
, 0},
7212 {":data", IMAGE_STRING_VALUE
, 0},
7213 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7214 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7215 {":relief", IMAGE_INTEGER_VALUE
, 0},
7216 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7217 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7220 /* Structure describing the image type `pbm'. */
7222 static struct image_type pbm_type
=
7232 /* Return non-zero if OBJECT is a valid PBM image specification. */
7235 pbm_image_p (object
)
7238 struct image_keyword fmt
[PBM_LAST
];
7240 bcopy (pbm_format
, fmt
, sizeof fmt
);
7242 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7245 /* Must specify either :data or :file. */
7246 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7250 /* Scan a decimal number from *S and return it. Advance *S while
7251 reading the number. END is the end of the string. Value is -1 at
7255 pbm_scan_number (s
, end
)
7256 unsigned char **s
, *end
;
7262 /* Skip white-space. */
7263 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7268 /* Skip comment to end of line. */
7269 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7272 else if (isdigit (c
))
7274 /* Read decimal number. */
7276 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7277 val
= 10 * val
+ c
- '0';
7288 /* Load PBM image IMG for use on frame F. */
7296 int width
, height
, max_color_idx
= 0;
7298 Lisp_Object file
, specified_file
;
7299 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7300 struct gcpro gcpro1
;
7301 unsigned char *contents
= NULL
;
7302 unsigned char *end
, *p
;
7305 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7309 if (STRINGP (specified_file
))
7311 file
= x_find_image_file (specified_file
);
7312 if (!STRINGP (file
))
7314 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7319 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7320 if (contents
== NULL
)
7322 image_error ("Error reading `%s'", file
, Qnil
);
7328 end
= contents
+ size
;
7333 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7334 p
= XSTRING (data
)->data
;
7335 end
= p
+ STRING_BYTES (XSTRING (data
));
7338 /* Check magic number. */
7339 if (end
- p
< 2 || *p
++ != 'P')
7341 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7351 raw_p
= 0, type
= PBM_MONO
;
7355 raw_p
= 0, type
= PBM_GRAY
;
7359 raw_p
= 0, type
= PBM_COLOR
;
7363 raw_p
= 1, type
= PBM_MONO
;
7367 raw_p
= 1, type
= PBM_GRAY
;
7371 raw_p
= 1, type
= PBM_COLOR
;
7375 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7379 /* Read width, height, maximum color-component. Characters
7380 starting with `#' up to the end of a line are ignored. */
7381 width
= pbm_scan_number (&p
, end
);
7382 height
= pbm_scan_number (&p
, end
);
7384 if (type
!= PBM_MONO
)
7386 max_color_idx
= pbm_scan_number (&p
, end
);
7387 if (raw_p
&& max_color_idx
> 255)
7388 max_color_idx
= 255;
7393 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7397 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7398 &ximg
, &img
->pixmap
))
7404 /* Initialize the color hash table. */
7405 init_color_table ();
7407 if (type
== PBM_MONO
)
7411 for (y
= 0; y
< height
; ++y
)
7412 for (x
= 0; x
< width
; ++x
)
7422 g
= pbm_scan_number (&p
, end
);
7424 XPutPixel (ximg
, x
, y
, (g
7425 ? FRAME_FOREGROUND_PIXEL (f
)
7426 : FRAME_BACKGROUND_PIXEL (f
)));
7431 for (y
= 0; y
< height
; ++y
)
7432 for (x
= 0; x
< width
; ++x
)
7436 if (type
== PBM_GRAY
)
7437 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7446 r
= pbm_scan_number (&p
, end
);
7447 g
= pbm_scan_number (&p
, end
);
7448 b
= pbm_scan_number (&p
, end
);
7451 if (r
< 0 || g
< 0 || b
< 0)
7455 XDestroyImage (ximg
);
7457 image_error ("Invalid pixel value in image `%s'",
7462 /* RGB values are now in the range 0..max_color_idx.
7463 Scale this to the range 0..0xffff supported by X. */
7464 r
= (double) r
* 65535 / max_color_idx
;
7465 g
= (double) g
* 65535 / max_color_idx
;
7466 b
= (double) b
* 65535 / max_color_idx
;
7467 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7471 /* Store in IMG->colors the colors allocated for the image, and
7472 free the color table. */
7473 img
->colors
= colors_in_color_table (&img
->ncolors
);
7474 free_color_table ();
7476 /* Put the image into a pixmap. */
7477 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7478 x_destroy_x_image (ximg
);
7482 img
->height
= height
;
7491 /***********************************************************************
7493 ***********************************************************************/
7499 /* Function prototypes. */
7501 static int png_image_p
P_ ((Lisp_Object object
));
7502 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7504 /* The symbol `png' identifying images of this type. */
7508 /* Indices of image specification fields in png_format, below. */
7510 enum png_keyword_index
7523 /* Vector of image_keyword structures describing the format
7524 of valid user-defined image specifications. */
7526 static struct image_keyword png_format
[PNG_LAST
] =
7528 {":type", IMAGE_SYMBOL_VALUE
, 1},
7529 {":data", IMAGE_STRING_VALUE
, 0},
7530 {":file", IMAGE_STRING_VALUE
, 0},
7531 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7532 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7533 {":relief", IMAGE_INTEGER_VALUE
, 0},
7534 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7535 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7538 /* Structure describing the image type `png'. */
7540 static struct image_type png_type
=
7550 /* Return non-zero if OBJECT is a valid PNG image specification. */
7553 png_image_p (object
)
7556 struct image_keyword fmt
[PNG_LAST
];
7557 bcopy (png_format
, fmt
, sizeof fmt
);
7559 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
7562 /* Must specify either the :data or :file keyword. */
7563 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
7567 /* Error and warning handlers installed when the PNG library
7571 my_png_error (png_ptr
, msg
)
7572 png_struct
*png_ptr
;
7575 xassert (png_ptr
!= NULL
);
7576 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7577 longjmp (png_ptr
->jmpbuf
, 1);
7582 my_png_warning (png_ptr
, msg
)
7583 png_struct
*png_ptr
;
7586 xassert (png_ptr
!= NULL
);
7587 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
7590 /* Memory source for PNG decoding. */
7592 struct png_memory_storage
7594 unsigned char *bytes
; /* The data */
7595 size_t len
; /* How big is it? */
7596 int index
; /* Where are we? */
7600 /* Function set as reader function when reading PNG image from memory.
7601 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7602 bytes from the input to DATA. */
7605 png_read_from_memory (png_ptr
, data
, length
)
7606 png_structp png_ptr
;
7610 struct png_memory_storage
*tbr
7611 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
7613 if (length
> tbr
->len
- tbr
->index
)
7614 png_error (png_ptr
, "Read error");
7616 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
7617 tbr
->index
= tbr
->index
+ length
;
7620 /* Load PNG image IMG for use on frame F. Value is non-zero if
7628 Lisp_Object file
, specified_file
;
7629 Lisp_Object specified_data
;
7631 XImage
*ximg
, *mask_img
= NULL
;
7632 struct gcpro gcpro1
;
7633 png_struct
*png_ptr
= NULL
;
7634 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
7637 png_byte
*pixels
= NULL
;
7638 png_byte
**rows
= NULL
;
7639 png_uint_32 width
, height
;
7640 int bit_depth
, color_type
, interlace_type
;
7642 png_uint_32 row_bytes
;
7645 double screen_gamma
, image_gamma
;
7647 struct png_memory_storage tbr
; /* Data to be read */
7649 /* Find out what file to load. */
7650 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7651 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7655 if (NILP (specified_data
))
7657 file
= x_find_image_file (specified_file
);
7658 if (!STRINGP (file
))
7660 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7665 /* Open the image file. */
7666 fp
= fopen (XSTRING (file
)->data
, "rb");
7669 image_error ("Cannot open image file `%s'", file
, Qnil
);
7675 /* Check PNG signature. */
7676 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
7677 || !png_check_sig (sig
, sizeof sig
))
7679 image_error ("Not a PNG file: `%s'", file
, Qnil
);
7687 /* Read from memory. */
7688 tbr
.bytes
= XSTRING (specified_data
)->data
;
7689 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
7692 /* Check PNG signature. */
7693 if (tbr
.len
< sizeof sig
7694 || !png_check_sig (tbr
.bytes
, sizeof sig
))
7696 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
7701 /* Need to skip past the signature. */
7702 tbr
.bytes
+= sizeof (sig
);
7705 /* Initialize read and info structs for PNG lib. */
7706 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
7707 my_png_error
, my_png_warning
);
7710 if (fp
) fclose (fp
);
7715 info_ptr
= png_create_info_struct (png_ptr
);
7718 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
7719 if (fp
) fclose (fp
);
7724 end_info
= png_create_info_struct (png_ptr
);
7727 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
7728 if (fp
) fclose (fp
);
7733 /* Set error jump-back. We come back here when the PNG library
7734 detects an error. */
7735 if (setjmp (png_ptr
->jmpbuf
))
7739 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7742 if (fp
) fclose (fp
);
7747 /* Read image info. */
7748 if (!NILP (specified_data
))
7749 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
7751 png_init_io (png_ptr
, fp
);
7753 png_set_sig_bytes (png_ptr
, sizeof sig
);
7754 png_read_info (png_ptr
, info_ptr
);
7755 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
7756 &interlace_type
, NULL
, NULL
);
7758 /* If image contains simply transparency data, we prefer to
7759 construct a clipping mask. */
7760 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
7765 /* This function is easier to write if we only have to handle
7766 one data format: RGB or RGBA with 8 bits per channel. Let's
7767 transform other formats into that format. */
7769 /* Strip more than 8 bits per channel. */
7770 if (bit_depth
== 16)
7771 png_set_strip_16 (png_ptr
);
7773 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
7775 png_set_expand (png_ptr
);
7777 /* Convert grayscale images to RGB. */
7778 if (color_type
== PNG_COLOR_TYPE_GRAY
7779 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
7780 png_set_gray_to_rgb (png_ptr
);
7782 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
7783 gamma_str
= getenv ("SCREEN_GAMMA");
7784 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
7786 /* Tell the PNG lib to handle gamma correction for us. */
7788 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
7789 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
7790 /* There is a special chunk in the image specifying the gamma. */
7791 png_set_sRGB (png_ptr
, info_ptr
, intent
);
7794 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
7795 /* Image contains gamma information. */
7796 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
7798 /* Use a default of 0.5 for the image gamma. */
7799 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
7801 /* Handle alpha channel by combining the image with a background
7802 color. Do this only if a real alpha channel is supplied. For
7803 simple transparency, we prefer a clipping mask. */
7806 png_color_16
*image_background
;
7808 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
7809 /* Image contains a background color with which to
7810 combine the image. */
7811 png_set_background (png_ptr
, image_background
,
7812 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
7815 /* Image does not contain a background color with which
7816 to combine the image data via an alpha channel. Use
7817 the frame's background instead. */
7820 png_color_16 frame_background
;
7823 cmap
= FRAME_X_COLORMAP (f
);
7824 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
7825 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7828 bzero (&frame_background
, sizeof frame_background
);
7829 frame_background
.red
= color
.red
;
7830 frame_background
.green
= color
.green
;
7831 frame_background
.blue
= color
.blue
;
7833 png_set_background (png_ptr
, &frame_background
,
7834 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
7838 /* Update info structure. */
7839 png_read_update_info (png_ptr
, info_ptr
);
7841 /* Get number of channels. Valid values are 1 for grayscale images
7842 and images with a palette, 2 for grayscale images with transparency
7843 information (alpha channel), 3 for RGB images, and 4 for RGB
7844 images with alpha channel, i.e. RGBA. If conversions above were
7845 sufficient we should only have 3 or 4 channels here. */
7846 channels
= png_get_channels (png_ptr
, info_ptr
);
7847 xassert (channels
== 3 || channels
== 4);
7849 /* Number of bytes needed for one row of the image. */
7850 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
7852 /* Allocate memory for the image. */
7853 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
7854 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
7855 for (i
= 0; i
< height
; ++i
)
7856 rows
[i
] = pixels
+ i
* row_bytes
;
7858 /* Read the entire image. */
7859 png_read_image (png_ptr
, rows
);
7860 png_read_end (png_ptr
, info_ptr
);
7869 /* Create the X image and pixmap. */
7870 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
7877 /* Create an image and pixmap serving as mask if the PNG image
7878 contains an alpha channel. */
7881 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
7882 &mask_img
, &img
->mask
))
7884 x_destroy_x_image (ximg
);
7885 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
7891 /* Fill the X image and mask from PNG data. */
7892 init_color_table ();
7894 for (y
= 0; y
< height
; ++y
)
7896 png_byte
*p
= rows
[y
];
7898 for (x
= 0; x
< width
; ++x
)
7905 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7907 /* An alpha channel, aka mask channel, associates variable
7908 transparency with an image. Where other image formats
7909 support binary transparency---fully transparent or fully
7910 opaque---PNG allows up to 254 levels of partial transparency.
7911 The PNG library implements partial transparency by combining
7912 the image with a specified background color.
7914 I'm not sure how to handle this here nicely: because the
7915 background on which the image is displayed may change, for
7916 real alpha channel support, it would be necessary to create
7917 a new image for each possible background.
7919 What I'm doing now is that a mask is created if we have
7920 boolean transparency information. Otherwise I'm using
7921 the frame's background color to combine the image with. */
7926 XPutPixel (mask_img
, x
, y
, *p
> 0);
7932 /* Remember colors allocated for this image. */
7933 img
->colors
= colors_in_color_table (&img
->ncolors
);
7934 free_color_table ();
7937 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
7942 img
->height
= height
;
7944 /* Put the image into the pixmap, then free the X image and its buffer. */
7945 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7946 x_destroy_x_image (ximg
);
7948 /* Same for the mask. */
7951 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7952 x_destroy_x_image (mask_img
);
7960 #endif /* HAVE_PNG != 0 */
7964 /***********************************************************************
7966 ***********************************************************************/
7970 /* Work around a warning about HAVE_STDLIB_H being redefined in
7972 #ifdef HAVE_STDLIB_H
7973 #define HAVE_STDLIB_H_1
7974 #undef HAVE_STDLIB_H
7975 #endif /* HAVE_STLIB_H */
7977 #include <jpeglib.h>
7981 #ifdef HAVE_STLIB_H_1
7982 #define HAVE_STDLIB_H 1
7985 static int jpeg_image_p
P_ ((Lisp_Object object
));
7986 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
7988 /* The symbol `jpeg' identifying images of this type. */
7992 /* Indices of image specification fields in gs_format, below. */
7994 enum jpeg_keyword_index
8003 JPEG_HEURISTIC_MASK
,
8007 /* Vector of image_keyword structures describing the format
8008 of valid user-defined image specifications. */
8010 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8012 {":type", IMAGE_SYMBOL_VALUE
, 1},
8013 {":data", IMAGE_STRING_VALUE
, 0},
8014 {":file", IMAGE_STRING_VALUE
, 0},
8015 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8016 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8017 {":relief", IMAGE_INTEGER_VALUE
, 0},
8018 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8019 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8022 /* Structure describing the image type `jpeg'. */
8024 static struct image_type jpeg_type
=
8034 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8037 jpeg_image_p (object
)
8040 struct image_keyword fmt
[JPEG_LAST
];
8042 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8044 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8047 /* Must specify either the :data or :file keyword. */
8048 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8052 struct my_jpeg_error_mgr
8054 struct jpeg_error_mgr pub
;
8055 jmp_buf setjmp_buffer
;
8060 my_error_exit (cinfo
)
8063 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8064 longjmp (mgr
->setjmp_buffer
, 1);
8068 /* Init source method for JPEG data source manager. Called by
8069 jpeg_read_header() before any data is actually read. See
8070 libjpeg.doc from the JPEG lib distribution. */
8073 our_init_source (cinfo
)
8074 j_decompress_ptr cinfo
;
8079 /* Fill input buffer method for JPEG data source manager. Called
8080 whenever more data is needed. We read the whole image in one step,
8081 so this only adds a fake end of input marker at the end. */
8084 our_fill_input_buffer (cinfo
)
8085 j_decompress_ptr cinfo
;
8087 /* Insert a fake EOI marker. */
8088 struct jpeg_source_mgr
*src
= cinfo
->src
;
8089 static JOCTET buffer
[2];
8091 buffer
[0] = (JOCTET
) 0xFF;
8092 buffer
[1] = (JOCTET
) JPEG_EOI
;
8094 src
->next_input_byte
= buffer
;
8095 src
->bytes_in_buffer
= 2;
8100 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8101 is the JPEG data source manager. */
8104 our_skip_input_data (cinfo
, num_bytes
)
8105 j_decompress_ptr cinfo
;
8108 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8112 if (num_bytes
> src
->bytes_in_buffer
)
8113 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8115 src
->bytes_in_buffer
-= num_bytes
;
8116 src
->next_input_byte
+= num_bytes
;
8121 /* Method to terminate data source. Called by
8122 jpeg_finish_decompress() after all data has been processed. */
8125 our_term_source (cinfo
)
8126 j_decompress_ptr cinfo
;
8131 /* Set up the JPEG lib for reading an image from DATA which contains
8132 LEN bytes. CINFO is the decompression info structure created for
8133 reading the image. */
8136 jpeg_memory_src (cinfo
, data
, len
)
8137 j_decompress_ptr cinfo
;
8141 struct jpeg_source_mgr
*src
;
8143 if (cinfo
->src
== NULL
)
8145 /* First time for this JPEG object? */
8146 cinfo
->src
= (struct jpeg_source_mgr
*)
8147 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8148 sizeof (struct jpeg_source_mgr
));
8149 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8150 src
->next_input_byte
= data
;
8153 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8154 src
->init_source
= our_init_source
;
8155 src
->fill_input_buffer
= our_fill_input_buffer
;
8156 src
->skip_input_data
= our_skip_input_data
;
8157 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8158 src
->term_source
= our_term_source
;
8159 src
->bytes_in_buffer
= len
;
8160 src
->next_input_byte
= data
;
8164 /* Load image IMG for use on frame F. Patterned after example.c
8165 from the JPEG lib. */
8172 struct jpeg_decompress_struct cinfo
;
8173 struct my_jpeg_error_mgr mgr
;
8174 Lisp_Object file
, specified_file
;
8175 Lisp_Object specified_data
;
8178 int row_stride
, x
, y
;
8179 XImage
*ximg
= NULL
;
8181 unsigned long *colors
;
8183 struct gcpro gcpro1
;
8185 /* Open the JPEG file. */
8186 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8187 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8191 if (NILP (specified_data
))
8193 file
= x_find_image_file (specified_file
);
8194 if (!STRINGP (file
))
8196 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8201 fp
= fopen (XSTRING (file
)->data
, "r");
8204 image_error ("Cannot open `%s'", file
, Qnil
);
8210 /* Customize libjpeg's error handling to call my_error_exit when an
8211 error is detected. This function will perform a longjmp. */
8212 mgr
.pub
.error_exit
= my_error_exit
;
8213 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8215 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8219 /* Called from my_error_exit. Display a JPEG error. */
8220 char buffer
[JMSG_LENGTH_MAX
];
8221 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8222 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8223 build_string (buffer
));
8226 /* Close the input file and destroy the JPEG object. */
8229 jpeg_destroy_decompress (&cinfo
);
8233 /* If we already have an XImage, free that. */
8234 x_destroy_x_image (ximg
);
8236 /* Free pixmap and colors. */
8237 x_clear_image (f
, img
);
8244 /* Create the JPEG decompression object. Let it read from fp.
8245 Read the JPEG image header. */
8246 jpeg_create_decompress (&cinfo
);
8248 if (NILP (specified_data
))
8249 jpeg_stdio_src (&cinfo
, fp
);
8251 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8252 STRING_BYTES (XSTRING (specified_data
)));
8254 jpeg_read_header (&cinfo
, TRUE
);
8256 /* Customize decompression so that color quantization will be used.
8257 Start decompression. */
8258 cinfo
.quantize_colors
= TRUE
;
8259 jpeg_start_decompress (&cinfo
);
8260 width
= img
->width
= cinfo
.output_width
;
8261 height
= img
->height
= cinfo
.output_height
;
8265 /* Create X image and pixmap. */
8266 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8269 longjmp (mgr
.setjmp_buffer
, 2);
8272 /* Allocate colors. When color quantization is used,
8273 cinfo.actual_number_of_colors has been set with the number of
8274 colors generated, and cinfo.colormap is a two-dimensional array
8275 of color indices in the range 0..cinfo.actual_number_of_colors.
8276 No more than 255 colors will be generated. */
8280 if (cinfo
.out_color_components
> 2)
8281 ir
= 0, ig
= 1, ib
= 2;
8282 else if (cinfo
.out_color_components
> 1)
8283 ir
= 0, ig
= 1, ib
= 0;
8285 ir
= 0, ig
= 0, ib
= 0;
8287 /* Use the color table mechanism because it handles colors that
8288 cannot be allocated nicely. Such colors will be replaced with
8289 a default color, and we don't have to care about which colors
8290 can be freed safely, and which can't. */
8291 init_color_table ();
8292 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8295 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8297 /* Multiply RGB values with 255 because X expects RGB values
8298 in the range 0..0xffff. */
8299 int r
= cinfo
.colormap
[ir
][i
] << 8;
8300 int g
= cinfo
.colormap
[ig
][i
] << 8;
8301 int b
= cinfo
.colormap
[ib
][i
] << 8;
8302 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8305 /* Remember those colors actually allocated. */
8306 img
->colors
= colors_in_color_table (&img
->ncolors
);
8307 free_color_table ();
8311 row_stride
= width
* cinfo
.output_components
;
8312 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8314 for (y
= 0; y
< height
; ++y
)
8316 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8317 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8318 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8322 jpeg_finish_decompress (&cinfo
);
8323 jpeg_destroy_decompress (&cinfo
);
8327 /* Put the image into the pixmap. */
8328 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8329 x_destroy_x_image (ximg
);
8335 #endif /* HAVE_JPEG */
8339 /***********************************************************************
8341 ***********************************************************************/
8347 static int tiff_image_p
P_ ((Lisp_Object object
));
8348 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8350 /* The symbol `tiff' identifying images of this type. */
8354 /* Indices of image specification fields in tiff_format, below. */
8356 enum tiff_keyword_index
8365 TIFF_HEURISTIC_MASK
,
8369 /* Vector of image_keyword structures describing the format
8370 of valid user-defined image specifications. */
8372 static struct image_keyword tiff_format
[TIFF_LAST
] =
8374 {":type", IMAGE_SYMBOL_VALUE
, 1},
8375 {":data", IMAGE_STRING_VALUE
, 0},
8376 {":file", IMAGE_STRING_VALUE
, 0},
8377 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8378 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8379 {":relief", IMAGE_INTEGER_VALUE
, 0},
8380 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8381 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8384 /* Structure describing the image type `tiff'. */
8386 static struct image_type tiff_type
=
8396 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8399 tiff_image_p (object
)
8402 struct image_keyword fmt
[TIFF_LAST
];
8403 bcopy (tiff_format
, fmt
, sizeof fmt
);
8405 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
8408 /* Must specify either the :data or :file keyword. */
8409 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8413 /* Reading from a memory buffer for TIFF images Based on the PNG
8414 memory source, but we have to provide a lot of extra functions.
8417 We really only need to implement read and seek, but I am not
8418 convinced that the TIFF library is smart enough not to destroy
8419 itself if we only hand it the function pointers we need to
8424 unsigned char *bytes
;
8432 tiff_read_from_memory (data
, buf
, size
)
8437 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8439 if (size
> src
->len
- src
->index
)
8441 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8448 tiff_write_from_memory (data
, buf
, size
)
8458 tiff_seek_in_memory (data
, off
, whence
)
8463 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8468 case SEEK_SET
: /* Go from beginning of source. */
8472 case SEEK_END
: /* Go from end of source. */
8473 idx
= src
->len
+ off
;
8476 case SEEK_CUR
: /* Go from current position. */
8477 idx
= src
->index
+ off
;
8480 default: /* Invalid `whence'. */
8484 if (idx
> src
->len
|| idx
< 0)
8493 tiff_close_memory (data
)
8502 tiff_mmap_memory (data
, pbase
, psize
)
8507 /* It is already _IN_ memory. */
8513 tiff_unmap_memory (data
, base
, size
)
8518 /* We don't need to do this. */
8523 tiff_size_of_memory (data
)
8526 return ((tiff_memory_source
*) data
)->len
;
8530 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8538 Lisp_Object file
, specified_file
;
8539 Lisp_Object specified_data
;
8541 int width
, height
, x
, y
;
8545 struct gcpro gcpro1
;
8546 tiff_memory_source memsrc
;
8548 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8549 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8553 if (NILP (specified_data
))
8555 /* Read from a file */
8556 file
= x_find_image_file (specified_file
);
8557 if (!STRINGP (file
))
8559 image_error ("Cannot find image file `%s'", file
, Qnil
);
8564 /* Try to open the image file. */
8565 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8568 image_error ("Cannot open `%s'", file
, Qnil
);
8575 /* Memory source! */
8576 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8577 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8580 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
8581 (TIFFReadWriteProc
) tiff_read_from_memory
,
8582 (TIFFReadWriteProc
) tiff_write_from_memory
,
8583 tiff_seek_in_memory
,
8585 tiff_size_of_memory
,
8591 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
8597 /* Get width and height of the image, and allocate a raster buffer
8598 of width x height 32-bit values. */
8599 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8600 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8601 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8603 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8607 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
8615 /* Create the X image and pixmap. */
8616 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8624 /* Initialize the color table. */
8625 init_color_table ();
8627 /* Process the pixel raster. Origin is in the lower-left corner. */
8628 for (y
= 0; y
< height
; ++y
)
8630 uint32
*row
= buf
+ y
* width
;
8632 for (x
= 0; x
< width
; ++x
)
8634 uint32 abgr
= row
[x
];
8635 int r
= TIFFGetR (abgr
) << 8;
8636 int g
= TIFFGetG (abgr
) << 8;
8637 int b
= TIFFGetB (abgr
) << 8;
8638 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8642 /* Remember the colors allocated for the image. Free the color table. */
8643 img
->colors
= colors_in_color_table (&img
->ncolors
);
8644 free_color_table ();
8646 /* Put the image into the pixmap, then free the X image and its buffer. */
8647 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8648 x_destroy_x_image (ximg
);
8653 img
->height
= height
;
8659 #endif /* HAVE_TIFF != 0 */
8663 /***********************************************************************
8665 ***********************************************************************/
8669 #include <gif_lib.h>
8671 static int gif_image_p
P_ ((Lisp_Object object
));
8672 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8674 /* The symbol `gif' identifying images of this type. */
8678 /* Indices of image specification fields in gif_format, below. */
8680 enum gif_keyword_index
8694 /* Vector of image_keyword structures describing the format
8695 of valid user-defined image specifications. */
8697 static struct image_keyword gif_format
[GIF_LAST
] =
8699 {":type", IMAGE_SYMBOL_VALUE
, 1},
8700 {":data", IMAGE_STRING_VALUE
, 0},
8701 {":file", IMAGE_STRING_VALUE
, 0},
8702 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8703 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8704 {":relief", IMAGE_INTEGER_VALUE
, 0},
8705 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8706 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8707 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8710 /* Structure describing the image type `gif'. */
8712 static struct image_type gif_type
=
8722 /* Return non-zero if OBJECT is a valid GIF image specification. */
8725 gif_image_p (object
)
8728 struct image_keyword fmt
[GIF_LAST
];
8729 bcopy (gif_format
, fmt
, sizeof fmt
);
8731 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
8734 /* Must specify either the :data or :file keyword. */
8735 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
8739 /* Reading a GIF image from memory
8740 Based on the PNG memory stuff to a certain extent. */
8744 unsigned char *bytes
;
8751 /* Make the current memory source available to gif_read_from_memory.
8752 It's done this way because not all versions of libungif support
8753 a UserData field in the GifFileType structure. */
8754 static gif_memory_source
*current_gif_memory_src
;
8757 gif_read_from_memory (file
, buf
, len
)
8762 gif_memory_source
*src
= current_gif_memory_src
;
8764 if (len
> src
->len
- src
->index
)
8767 bcopy (src
->bytes
+ src
->index
, buf
, len
);
8773 /* Load GIF image IMG for use on frame F. Value is non-zero if
8781 Lisp_Object file
, specified_file
;
8782 Lisp_Object specified_data
;
8783 int rc
, width
, height
, x
, y
, i
;
8785 ColorMapObject
*gif_color_map
;
8786 unsigned long pixel_colors
[256];
8788 struct gcpro gcpro1
;
8790 int ino
, image_left
, image_top
, image_width
, image_height
;
8791 gif_memory_source memsrc
;
8792 unsigned char *raster
;
8794 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8795 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8799 if (NILP (specified_data
))
8801 file
= x_find_image_file (specified_file
);
8802 if (!STRINGP (file
))
8804 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8809 /* Open the GIF file. */
8810 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8813 image_error ("Cannot open `%s'", file
, Qnil
);
8820 /* Read from memory! */
8821 current_gif_memory_src
= &memsrc
;
8822 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8823 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8826 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
8829 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
8835 /* Read entire contents. */
8836 rc
= DGifSlurp (gif
);
8837 if (rc
== GIF_ERROR
)
8839 image_error ("Error reading `%s'", img
->spec
, Qnil
);
8840 DGifCloseFile (gif
);
8845 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8846 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8847 if (ino
>= gif
->ImageCount
)
8849 image_error ("Invalid image number `%s' in image `%s'",
8851 DGifCloseFile (gif
);
8856 width
= img
->width
= gif
->SWidth
;
8857 height
= img
->height
= gif
->SHeight
;
8861 /* Create the X image and pixmap. */
8862 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8865 DGifCloseFile (gif
);
8870 /* Allocate colors. */
8871 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8873 gif_color_map
= gif
->SColorMap
;
8874 init_color_table ();
8875 bzero (pixel_colors
, sizeof pixel_colors
);
8877 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8879 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8880 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8881 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8882 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8885 img
->colors
= colors_in_color_table (&img
->ncolors
);
8886 free_color_table ();
8888 /* Clear the part of the screen image that are not covered by
8889 the image from the GIF file. Full animated GIF support
8890 requires more than can be done here (see the gif89 spec,
8891 disposal methods). Let's simply assume that the part
8892 not covered by a sub-image is in the frame's background color. */
8893 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8894 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8895 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8896 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8898 for (y
= 0; y
< image_top
; ++y
)
8899 for (x
= 0; x
< width
; ++x
)
8900 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8902 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8903 for (x
= 0; x
< width
; ++x
)
8904 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8906 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8908 for (x
= 0; x
< image_left
; ++x
)
8909 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8910 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8911 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8914 /* Read the GIF image into the X image. We use a local variable
8915 `raster' here because RasterBits below is a char *, and invites
8916 problems with bytes >= 0x80. */
8917 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
8919 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8921 static int interlace_start
[] = {0, 4, 2, 1};
8922 static int interlace_increment
[] = {8, 8, 4, 2};
8924 int row
= interlace_start
[0];
8928 for (y
= 0; y
< image_height
; y
++)
8930 if (row
>= image_height
)
8932 row
= interlace_start
[++pass
];
8933 while (row
>= image_height
)
8934 row
= interlace_start
[++pass
];
8937 for (x
= 0; x
< image_width
; x
++)
8939 int i
= raster
[(y
* image_width
) + x
];
8940 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8944 row
+= interlace_increment
[pass
];
8949 for (y
= 0; y
< image_height
; ++y
)
8950 for (x
= 0; x
< image_width
; ++x
)
8952 int i
= raster
[y
* image_width
+ x
];
8953 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8957 DGifCloseFile (gif
);
8959 /* Put the image into the pixmap, then free the X image and its buffer. */
8960 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8961 x_destroy_x_image (ximg
);
8968 #endif /* HAVE_GIF != 0 */
8972 /***********************************************************************
8974 ***********************************************************************/
8976 static int gs_image_p
P_ ((Lisp_Object object
));
8977 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8978 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8980 /* The symbol `postscript' identifying images of this type. */
8982 Lisp_Object Qpostscript
;
8984 /* Keyword symbols. */
8986 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
8988 /* Indices of image specification fields in gs_format, below. */
8990 enum gs_keyword_index
9006 /* Vector of image_keyword structures describing the format
9007 of valid user-defined image specifications. */
9009 static struct image_keyword gs_format
[GS_LAST
] =
9011 {":type", IMAGE_SYMBOL_VALUE
, 1},
9012 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9013 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9014 {":file", IMAGE_STRING_VALUE
, 1},
9015 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9016 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9017 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9018 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9019 {":relief", IMAGE_INTEGER_VALUE
, 0},
9020 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9021 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9024 /* Structure describing the image type `ghostscript'. */
9026 static struct image_type gs_type
=
9036 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9039 gs_clear_image (f
, img
)
9043 /* IMG->data.ptr_val may contain a recorded colormap. */
9044 xfree (img
->data
.ptr_val
);
9045 x_clear_image (f
, img
);
9049 /* Return non-zero if OBJECT is a valid Ghostscript image
9056 struct image_keyword fmt
[GS_LAST
];
9060 bcopy (gs_format
, fmt
, sizeof fmt
);
9062 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9065 /* Bounding box must be a list or vector containing 4 integers. */
9066 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9069 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9070 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9075 else if (VECTORP (tem
))
9077 if (XVECTOR (tem
)->size
!= 4)
9079 for (i
= 0; i
< 4; ++i
)
9080 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9090 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9099 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9100 struct gcpro gcpro1
, gcpro2
;
9102 double in_width
, in_height
;
9103 Lisp_Object pixel_colors
= Qnil
;
9105 /* Compute pixel size of pixmap needed from the given size in the
9106 image specification. Sizes in the specification are in pt. 1 pt
9107 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9109 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9110 in_width
= XFASTINT (pt_width
) / 72.0;
9111 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9112 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9113 in_height
= XFASTINT (pt_height
) / 72.0;
9114 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9116 /* Create the pixmap. */
9118 xassert (img
->pixmap
== 0);
9119 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9120 img
->width
, img
->height
,
9121 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9126 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9130 /* Call the loader to fill the pixmap. It returns a process object
9131 if successful. We do not record_unwind_protect here because
9132 other places in redisplay like calling window scroll functions
9133 don't either. Let the Lisp loader use `unwind-protect' instead. */
9134 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9136 sprintf (buffer
, "%lu %lu",
9137 (unsigned long) FRAME_X_WINDOW (f
),
9138 (unsigned long) img
->pixmap
);
9139 window_and_pixmap_id
= build_string (buffer
);
9141 sprintf (buffer
, "%lu %lu",
9142 FRAME_FOREGROUND_PIXEL (f
),
9143 FRAME_BACKGROUND_PIXEL (f
));
9144 pixel_colors
= build_string (buffer
);
9146 XSETFRAME (frame
, f
);
9147 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9149 loader
= intern ("gs-load-image");
9151 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9152 make_number (img
->width
),
9153 make_number (img
->height
),
9154 window_and_pixmap_id
,
9157 return PROCESSP (img
->data
.lisp_val
);
9161 /* Kill the Ghostscript process that was started to fill PIXMAP on
9162 frame F. Called from XTread_socket when receiving an event
9163 telling Emacs that Ghostscript has finished drawing. */
9166 x_kill_gs_process (pixmap
, f
)
9170 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9174 /* Find the image containing PIXMAP. */
9175 for (i
= 0; i
< c
->used
; ++i
)
9176 if (c
->images
[i
]->pixmap
== pixmap
)
9179 /* Kill the GS process. We should have found PIXMAP in the image
9180 cache and its image should contain a process object. */
9181 xassert (i
< c
->used
);
9183 xassert (PROCESSP (img
->data
.lisp_val
));
9184 Fkill_process (img
->data
.lisp_val
, Qnil
);
9185 img
->data
.lisp_val
= Qnil
;
9187 /* On displays with a mutable colormap, figure out the colors
9188 allocated for the image by looking at the pixels of an XImage for
9190 class = FRAME_X_VISUAL (f
)->class;
9191 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9197 /* Try to get an XImage for img->pixmep. */
9198 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9199 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9204 /* Initialize the color table. */
9205 init_color_table ();
9207 /* For each pixel of the image, look its color up in the
9208 color table. After having done so, the color table will
9209 contain an entry for each color used by the image. */
9210 for (y
= 0; y
< img
->height
; ++y
)
9211 for (x
= 0; x
< img
->width
; ++x
)
9213 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9214 lookup_pixel_color (f
, pixel
);
9217 /* Record colors in the image. Free color table and XImage. */
9218 img
->colors
= colors_in_color_table (&img
->ncolors
);
9219 free_color_table ();
9220 XDestroyImage (ximg
);
9222 #if 0 /* This doesn't seem to be the case. If we free the colors
9223 here, we get a BadAccess later in x_clear_image when
9224 freeing the colors. */
9225 /* We have allocated colors once, but Ghostscript has also
9226 allocated colors on behalf of us. So, to get the
9227 reference counts right, free them once. */
9229 x_free_colors (f
, img
->colors
, img
->ncolors
);
9233 image_error ("Cannot get X image of `%s'; colors will not be freed",
9242 /***********************************************************************
9244 ***********************************************************************/
9246 DEFUN ("x-change-window-property", Fx_change_window_property
,
9247 Sx_change_window_property
, 2, 3, 0,
9248 "Change window property PROP to VALUE on the X window of FRAME.\n\
9249 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9250 selected frame. Value is VALUE.")
9251 (prop
, value
, frame
)
9252 Lisp_Object frame
, prop
, value
;
9254 struct frame
*f
= check_x_frame (frame
);
9257 CHECK_STRING (prop
, 1);
9258 CHECK_STRING (value
, 2);
9261 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9262 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9263 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9264 XSTRING (value
)->data
, XSTRING (value
)->size
);
9266 /* Make sure the property is set when we return. */
9267 XFlush (FRAME_X_DISPLAY (f
));
9274 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9275 Sx_delete_window_property
, 1, 2, 0,
9276 "Remove window property PROP from X window of FRAME.\n\
9277 FRAME nil or omitted means use the selected frame. Value is PROP.")
9279 Lisp_Object prop
, frame
;
9281 struct frame
*f
= check_x_frame (frame
);
9284 CHECK_STRING (prop
, 1);
9286 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9287 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9289 /* Make sure the property is removed when we return. */
9290 XFlush (FRAME_X_DISPLAY (f
));
9297 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9299 "Value is the value of window property PROP on FRAME.\n\
9300 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9301 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9304 Lisp_Object prop
, frame
;
9306 struct frame
*f
= check_x_frame (frame
);
9309 Lisp_Object prop_value
= Qnil
;
9310 char *tmp_data
= NULL
;
9313 unsigned long actual_size
, bytes_remaining
;
9315 CHECK_STRING (prop
, 1);
9317 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9318 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9319 prop_atom
, 0, 0, False
, XA_STRING
,
9320 &actual_type
, &actual_format
, &actual_size
,
9321 &bytes_remaining
, (unsigned char **) &tmp_data
);
9324 int size
= bytes_remaining
;
9329 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9330 prop_atom
, 0, bytes_remaining
,
9332 &actual_type
, &actual_format
,
9333 &actual_size
, &bytes_remaining
,
9334 (unsigned char **) &tmp_data
);
9336 prop_value
= make_string (tmp_data
, size
);
9347 /***********************************************************************
9349 ***********************************************************************/
9351 /* If non-null, an asynchronous timer that, when it expires, displays
9352 a busy cursor on all frames. */
9354 static struct atimer
*busy_cursor_atimer
;
9356 /* Non-zero means a busy cursor is currently shown. */
9358 static int busy_cursor_shown_p
;
9360 /* Number of seconds to wait before displaying a busy cursor. */
9362 static Lisp_Object Vbusy_cursor_delay
;
9364 /* Default number of seconds to wait before displaying a busy
9367 #define DEFAULT_BUSY_CURSOR_DELAY 1
9369 /* Function prototypes. */
9371 static void show_busy_cursor
P_ ((struct atimer
*));
9372 static void hide_busy_cursor
P_ ((void));
9375 /* Cancel a currently active busy-cursor timer, and start a new one. */
9378 start_busy_cursor ()
9381 int secs
, usecs
= 0;
9383 cancel_busy_cursor ();
9385 if (INTEGERP (Vbusy_cursor_delay
)
9386 && XINT (Vbusy_cursor_delay
) > 0)
9387 secs
= XFASTINT (Vbusy_cursor_delay
);
9388 else if (FLOATP (Vbusy_cursor_delay
)
9389 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
9392 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
9393 secs
= XFASTINT (tem
);
9394 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
9397 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
9399 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
9400 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
9401 show_busy_cursor
, NULL
);
9405 /* Cancel the busy cursor timer if active, hide a busy cursor if
9409 cancel_busy_cursor ()
9411 if (busy_cursor_atimer
)
9413 cancel_atimer (busy_cursor_atimer
);
9414 busy_cursor_atimer
= NULL
;
9417 if (busy_cursor_shown_p
)
9418 hide_busy_cursor ();
9422 /* Timer function of busy_cursor_atimer. TIMER is equal to
9425 Display a busy cursor on all frames by mapping the frames'
9426 busy_window. Set the busy_p flag in the frames' output_data.x
9427 structure to indicate that a busy cursor is shown on the
9431 show_busy_cursor (timer
)
9432 struct atimer
*timer
;
9434 /* The timer implementation will cancel this timer automatically
9435 after this function has run. Set busy_cursor_atimer to null
9436 so that we know the timer doesn't have to be canceled. */
9437 busy_cursor_atimer
= NULL
;
9439 if (!busy_cursor_shown_p
)
9441 Lisp_Object rest
, frame
;
9445 FOR_EACH_FRAME (rest
, frame
)
9446 if (FRAME_X_P (XFRAME (frame
)))
9448 struct frame
*f
= XFRAME (frame
);
9450 f
->output_data
.x
->busy_p
= 1;
9452 if (!f
->output_data
.x
->busy_window
)
9454 unsigned long mask
= CWCursor
;
9455 XSetWindowAttributes attrs
;
9457 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9459 f
->output_data
.x
->busy_window
9460 = XCreateWindow (FRAME_X_DISPLAY (f
),
9461 FRAME_OUTER_WINDOW (f
),
9462 0, 0, 32000, 32000, 0, 0,
9468 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9469 XFlush (FRAME_X_DISPLAY (f
));
9472 busy_cursor_shown_p
= 1;
9478 /* Hide the busy cursor on all frames, if it is currently shown. */
9483 if (busy_cursor_shown_p
)
9485 Lisp_Object rest
, frame
;
9488 FOR_EACH_FRAME (rest
, frame
)
9490 struct frame
*f
= XFRAME (frame
);
9493 /* Watch out for newly created frames. */
9494 && f
->output_data
.x
->busy_window
)
9496 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9497 /* Sync here because XTread_socket looks at the busy_p flag
9498 that is reset to zero below. */
9499 XSync (FRAME_X_DISPLAY (f
), False
);
9500 f
->output_data
.x
->busy_p
= 0;
9504 busy_cursor_shown_p
= 0;
9511 /***********************************************************************
9513 ***********************************************************************/
9515 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9518 /* The frame of a currently visible tooltip, or null. */
9520 struct frame
*tip_frame
;
9522 /* If non-nil, a timer started that hides the last tooltip when it
9525 Lisp_Object tip_timer
;
9528 /* Create a frame for a tooltip on the display described by DPYINFO.
9529 PARMS is a list of frame parameters. Value is the frame. */
9532 x_create_tip_frame (dpyinfo
, parms
)
9533 struct x_display_info
*dpyinfo
;
9537 Lisp_Object frame
, tem
;
9539 long window_prompting
= 0;
9541 int count
= specpdl_ptr
- specpdl
;
9542 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9547 /* Use this general default value to start with until we know if
9548 this frame has a specified name. */
9549 Vx_resource_name
= Vinvocation_name
;
9552 kb
= dpyinfo
->kboard
;
9554 kb
= &the_only_kboard
;
9557 /* Get the name of the frame to use for resource lookup. */
9558 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9560 && !EQ (name
, Qunbound
)
9562 error ("Invalid frame name--not a string or nil");
9563 Vx_resource_name
= name
;
9566 GCPRO3 (parms
, name
, frame
);
9567 tip_frame
= f
= make_frame (1);
9568 XSETFRAME (frame
, f
);
9569 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9571 f
->output_method
= output_x_window
;
9572 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9573 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9574 f
->output_data
.x
->icon_bitmap
= -1;
9575 f
->output_data
.x
->fontset
= -1;
9576 f
->icon_name
= Qnil
;
9577 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9579 FRAME_KBOARD (f
) = kb
;
9581 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9582 f
->output_data
.x
->explicit_parent
= 0;
9584 /* Set the name; the functions to which we pass f expect the name to
9586 if (EQ (name
, Qunbound
) || NILP (name
))
9588 f
->name
= build_string (dpyinfo
->x_id_name
);
9589 f
->explicit_name
= 0;
9594 f
->explicit_name
= 1;
9595 /* use the frame's title when getting resources for this frame. */
9596 specbind (Qx_resource_name
, name
);
9599 /* Extract the window parameters from the supplied values
9600 that are needed to determine window geometry. */
9604 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9607 /* First, try whatever font the caller has specified. */
9610 tem
= Fquery_fontset (font
, Qnil
);
9612 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9614 font
= x_new_font (f
, XSTRING (font
)->data
);
9617 /* Try out a font which we hope has bold and italic variations. */
9618 if (!STRINGP (font
))
9619 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9620 if (!STRINGP (font
))
9621 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9622 if (! STRINGP (font
))
9623 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9624 if (! STRINGP (font
))
9625 /* This was formerly the first thing tried, but it finds too many fonts
9626 and takes too long. */
9627 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9628 /* If those didn't work, look for something which will at least work. */
9629 if (! STRINGP (font
))
9630 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9632 if (! STRINGP (font
))
9633 font
= build_string ("fixed");
9635 x_default_parameter (f
, parms
, Qfont
, font
,
9636 "font", "Font", RES_TYPE_STRING
);
9639 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9640 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9642 /* This defaults to 2 in order to match xterm. We recognize either
9643 internalBorderWidth or internalBorder (which is what xterm calls
9645 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9649 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9650 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9651 if (! EQ (value
, Qunbound
))
9652 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9656 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9657 "internalBorderWidth", "internalBorderWidth",
9660 /* Also do the stuff which must be set before the window exists. */
9661 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9662 "foreground", "Foreground", RES_TYPE_STRING
);
9663 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9664 "background", "Background", RES_TYPE_STRING
);
9665 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9666 "pointerColor", "Foreground", RES_TYPE_STRING
);
9667 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9668 "cursorColor", "Foreground", RES_TYPE_STRING
);
9669 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9670 "borderColor", "BorderColor", RES_TYPE_STRING
);
9672 /* Init faces before x_default_parameter is called for scroll-bar
9673 parameters because that function calls x_set_scroll_bar_width,
9674 which calls change_frame_size, which calls Fset_window_buffer,
9675 which runs hooks, which call Fvertical_motion. At the end, we
9676 end up in init_iterator with a null face cache, which should not
9678 init_frame_faces (f
);
9680 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9681 window_prompting
= x_figure_window_size (f
, parms
);
9683 if (window_prompting
& XNegative
)
9685 if (window_prompting
& YNegative
)
9686 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9688 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9692 if (window_prompting
& YNegative
)
9693 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9695 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9698 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9700 XSetWindowAttributes attrs
;
9704 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9705 /* Window managers look at the override-redirect flag to determine
9706 whether or net to give windows a decoration (Xlib spec, chapter
9708 attrs
.override_redirect
= True
;
9709 attrs
.save_under
= True
;
9710 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9711 /* Arrange for getting MapNotify and UnmapNotify events. */
9712 attrs
.event_mask
= StructureNotifyMask
;
9714 = FRAME_X_WINDOW (f
)
9715 = XCreateWindow (FRAME_X_DISPLAY (f
),
9716 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9717 /* x, y, width, height */
9721 CopyFromParent
, InputOutput
, CopyFromParent
,
9728 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9729 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9730 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9731 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9732 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9733 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9735 /* Dimensions, especially f->height, must be done via change_frame_size.
9736 Change will not be effected unless different from the current
9741 SET_FRAME_WIDTH (f
, 0);
9742 change_frame_size (f
, height
, width
, 1, 0, 0);
9748 /* It is now ok to make the frame official even if we get an error
9749 below. And the frame needs to be on Vframe_list or making it
9750 visible won't work. */
9751 Vframe_list
= Fcons (frame
, Vframe_list
);
9753 /* Now that the frame is official, it counts as a reference to
9755 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9757 return unbind_to (count
, frame
);
9761 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9762 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9763 A tooltip window is a small X window displaying STRING at\n\
9764 the current mouse position.\n\
9765 FRAME nil or omitted means use the selected frame.\n\
9766 PARMS is an optional list of frame parameters which can be\n\
9767 used to change the tooltip's appearance.\n\
9768 Automatically hide the tooltip after TIMEOUT seconds.\n\
9769 TIMEOUT nil means use the default timeout of 5 seconds.")
9770 (string
, frame
, parms
, timeout
)
9771 Lisp_Object string
, frame
, parms
, timeout
;
9777 struct buffer
*old_buffer
;
9778 struct text_pos pos
;
9779 int i
, width
, height
;
9780 int root_x
, root_y
, win_x
, win_y
;
9782 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
9783 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9784 int count
= specpdl_ptr
- specpdl
;
9786 specbind (Qinhibit_redisplay
, Qt
);
9788 GCPRO4 (string
, parms
, frame
, timeout
);
9790 CHECK_STRING (string
, 0);
9791 f
= check_x_frame (frame
);
9793 timeout
= make_number (5);
9795 CHECK_NATNUM (timeout
, 2);
9797 /* Hide a previous tip, if any. */
9800 /* Add default values to frame parameters. */
9801 if (NILP (Fassq (Qname
, parms
)))
9802 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9803 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9804 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9805 if (NILP (Fassq (Qborder_width
, parms
)))
9806 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9807 if (NILP (Fassq (Qborder_color
, parms
)))
9808 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9809 if (NILP (Fassq (Qbackground_color
, parms
)))
9810 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9813 /* Create a frame for the tooltip, and record it in the global
9814 variable tip_frame. */
9815 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9816 tip_frame
= f
= XFRAME (frame
);
9818 /* Set up the frame's root window. Currently we use a size of 80
9819 columns x 40 lines. If someone wants to show a larger tip, he
9820 will loose. I don't think this is a realistic case. */
9821 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9822 w
->left
= w
->top
= make_number (0);
9823 w
->width
= make_number (80);
9824 w
->height
= make_number (40);
9826 w
->pseudo_window_p
= 1;
9828 /* Display the tooltip text in a temporary buffer. */
9829 buffer
= Fget_buffer_create (build_string (" *tip*"));
9830 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9831 old_buffer
= current_buffer
;
9832 set_buffer_internal_1 (XBUFFER (buffer
));
9834 Finsert (1, &string
);
9835 clear_glyph_matrix (w
->desired_matrix
);
9836 clear_glyph_matrix (w
->current_matrix
);
9837 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9838 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9840 /* Compute width and height of the tooltip. */
9842 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9844 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9848 /* Stop at the first empty row at the end. */
9849 if (!row
->enabled_p
|| !row
->displays_text_p
)
9852 /* Let the row go over the full width of the frame. */
9853 row
->full_width_p
= 1;
9855 /* There's a glyph at the end of rows that is used to place
9856 the cursor there. Don't include the width of this glyph. */
9857 if (row
->used
[TEXT_AREA
])
9859 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9860 row_width
= row
->pixel_width
- last
->pixel_width
;
9863 row_width
= row
->pixel_width
;
9865 height
+= row
->height
;
9866 width
= max (width
, row_width
);
9869 /* Add the frame's internal border to the width and height the X
9870 window should have. */
9871 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9872 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9874 /* Move the tooltip window where the mouse pointer is. Resize and
9877 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9878 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9879 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9880 root_x
+ 5, root_y
- height
- 5, width
, height
);
9881 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9884 /* Draw into the window. */
9885 w
->must_be_updated_p
= 1;
9886 update_single_window (w
, 1);
9888 /* Restore original current buffer. */
9889 set_buffer_internal_1 (old_buffer
);
9890 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9892 /* Let the tip disappear after timeout seconds. */
9893 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9894 intern ("x-hide-tip"));
9897 return unbind_to (count
, Qnil
);
9901 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9902 "Hide the current tooltip window, if there is any.\n\
9903 Value is t is tooltip was open, nil otherwise.")
9906 int count
= specpdl_ptr
- specpdl
;
9909 specbind (Qinhibit_redisplay
, Qt
);
9911 if (!NILP (tip_timer
))
9913 call1 (intern ("cancel-timer"), tip_timer
);
9921 XSETFRAME (frame
, tip_frame
);
9922 Fdelete_frame (frame
, Qt
);
9927 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9932 /***********************************************************************
9933 File selection dialog
9934 ***********************************************************************/
9938 /* Callback for "OK" and "Cancel" on file selection dialog. */
9941 file_dialog_cb (widget
, client_data
, call_data
)
9943 XtPointer call_data
, client_data
;
9945 int *result
= (int *) client_data
;
9946 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9947 *result
= cb
->reason
;
9951 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9952 "Read file name, prompting with PROMPT in directory DIR.\n\
9953 Use a file selection dialog.\n\
9954 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9955 specified. Don't let the user enter a file name in the file\n\
9956 selection dialog's entry field, if MUSTMATCH is non-nil.")
9957 (prompt
, dir
, default_filename
, mustmatch
)
9958 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9961 struct frame
*f
= SELECTED_FRAME ();
9962 Lisp_Object file
= Qnil
;
9963 Widget dialog
, text
, list
, help
;
9966 extern XtAppContext Xt_app_con
;
9968 XmString dir_xmstring
, pattern_xmstring
;
9969 int popup_activated_flag
;
9970 int count
= specpdl_ptr
- specpdl
;
9971 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9973 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9974 CHECK_STRING (prompt
, 0);
9975 CHECK_STRING (dir
, 1);
9977 /* Prevent redisplay. */
9978 specbind (Qinhibit_redisplay
, Qt
);
9982 /* Create the dialog with PROMPT as title, using DIR as initial
9983 directory and using "*" as pattern. */
9984 dir
= Fexpand_file_name (dir
, Qnil
);
9985 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9986 pattern_xmstring
= XmStringCreateLocalized ("*");
9988 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9989 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9990 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9991 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9992 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9993 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9995 XmStringFree (dir_xmstring
);
9996 XmStringFree (pattern_xmstring
);
9998 /* Add callbacks for OK and Cancel. */
9999 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10000 (XtPointer
) &result
);
10001 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10002 (XtPointer
) &result
);
10004 /* Disable the help button since we can't display help. */
10005 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10006 XtSetSensitive (help
, False
);
10008 /* Mark OK button as default. */
10009 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10010 XmNshowAsDefault
, True
, NULL
);
10012 /* If MUSTMATCH is non-nil, disable the file entry field of the
10013 dialog, so that the user must select a file from the files list
10014 box. We can't remove it because we wouldn't have a way to get at
10015 the result file name, then. */
10016 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10017 if (!NILP (mustmatch
))
10020 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10021 XtSetSensitive (text
, False
);
10022 XtSetSensitive (label
, False
);
10025 /* Manage the dialog, so that list boxes get filled. */
10026 XtManageChild (dialog
);
10028 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10029 must include the path for this to work. */
10030 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10031 if (STRINGP (default_filename
))
10033 XmString default_xmstring
;
10037 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10039 if (!XmListItemExists (list
, default_xmstring
))
10041 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10042 XmListAddItem (list
, default_xmstring
, 0);
10046 item_pos
= XmListItemPos (list
, default_xmstring
);
10047 XmStringFree (default_xmstring
);
10049 /* Select the item and scroll it into view. */
10050 XmListSelectPos (list
, item_pos
, True
);
10051 XmListSetPos (list
, item_pos
);
10054 /* Process all events until the user presses Cancel or OK. */
10055 for (result
= 0; result
== 0;)
10058 Widget widget
, parent
;
10060 XtAppNextEvent (Xt_app_con
, &event
);
10062 /* See if the receiver of the event is one of the widgets of
10063 the file selection dialog. If so, dispatch it. If not,
10065 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10067 while (parent
&& parent
!= dialog
)
10068 parent
= XtParent (parent
);
10070 if (parent
== dialog
10071 || (event
.type
== Expose
10072 && !process_expose_from_menu (event
)))
10073 XtDispatchEvent (&event
);
10076 /* Get the result. */
10077 if (result
== XmCR_OK
)
10082 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10083 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10084 XmStringFree (text
);
10085 file
= build_string (data
);
10092 XtUnmanageChild (dialog
);
10093 XtDestroyWidget (dialog
);
10097 /* Make "Cancel" equivalent to C-g. */
10099 Fsignal (Qquit
, Qnil
);
10101 return unbind_to (count
, file
);
10104 #endif /* USE_MOTIF */
10108 /***********************************************************************
10110 ***********************************************************************/
10115 /* This is zero if not using X windows. */
10118 /* The section below is built by the lisp expression at the top of the file,
10119 just above where these variables are declared. */
10120 /*&&& init symbols here &&&*/
10121 Qauto_raise
= intern ("auto-raise");
10122 staticpro (&Qauto_raise
);
10123 Qauto_lower
= intern ("auto-lower");
10124 staticpro (&Qauto_lower
);
10125 Qbar
= intern ("bar");
10127 Qborder_color
= intern ("border-color");
10128 staticpro (&Qborder_color
);
10129 Qborder_width
= intern ("border-width");
10130 staticpro (&Qborder_width
);
10131 Qbox
= intern ("box");
10133 Qcursor_color
= intern ("cursor-color");
10134 staticpro (&Qcursor_color
);
10135 Qcursor_type
= intern ("cursor-type");
10136 staticpro (&Qcursor_type
);
10137 Qgeometry
= intern ("geometry");
10138 staticpro (&Qgeometry
);
10139 Qicon_left
= intern ("icon-left");
10140 staticpro (&Qicon_left
);
10141 Qicon_top
= intern ("icon-top");
10142 staticpro (&Qicon_top
);
10143 Qicon_type
= intern ("icon-type");
10144 staticpro (&Qicon_type
);
10145 Qicon_name
= intern ("icon-name");
10146 staticpro (&Qicon_name
);
10147 Qinternal_border_width
= intern ("internal-border-width");
10148 staticpro (&Qinternal_border_width
);
10149 Qleft
= intern ("left");
10150 staticpro (&Qleft
);
10151 Qright
= intern ("right");
10152 staticpro (&Qright
);
10153 Qmouse_color
= intern ("mouse-color");
10154 staticpro (&Qmouse_color
);
10155 Qnone
= intern ("none");
10156 staticpro (&Qnone
);
10157 Qparent_id
= intern ("parent-id");
10158 staticpro (&Qparent_id
);
10159 Qscroll_bar_width
= intern ("scroll-bar-width");
10160 staticpro (&Qscroll_bar_width
);
10161 Qsuppress_icon
= intern ("suppress-icon");
10162 staticpro (&Qsuppress_icon
);
10163 Qundefined_color
= intern ("undefined-color");
10164 staticpro (&Qundefined_color
);
10165 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10166 staticpro (&Qvertical_scroll_bars
);
10167 Qvisibility
= intern ("visibility");
10168 staticpro (&Qvisibility
);
10169 Qwindow_id
= intern ("window-id");
10170 staticpro (&Qwindow_id
);
10171 Qouter_window_id
= intern ("outer-window-id");
10172 staticpro (&Qouter_window_id
);
10173 Qx_frame_parameter
= intern ("x-frame-parameter");
10174 staticpro (&Qx_frame_parameter
);
10175 Qx_resource_name
= intern ("x-resource-name");
10176 staticpro (&Qx_resource_name
);
10177 Quser_position
= intern ("user-position");
10178 staticpro (&Quser_position
);
10179 Quser_size
= intern ("user-size");
10180 staticpro (&Quser_size
);
10181 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10182 staticpro (&Qscroll_bar_foreground
);
10183 Qscroll_bar_background
= intern ("scroll-bar-background");
10184 staticpro (&Qscroll_bar_background
);
10185 Qscreen_gamma
= intern ("screen-gamma");
10186 staticpro (&Qscreen_gamma
);
10187 Qline_spacing
= intern ("line-spacing");
10188 staticpro (&Qline_spacing
);
10189 Qcenter
= intern ("center");
10190 staticpro (&Qcenter
);
10191 /* This is the end of symbol initialization. */
10193 /* Text property `display' should be nonsticky by default. */
10194 Vtext_property_default_nonsticky
10195 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10198 Qlaplace
= intern ("laplace");
10199 staticpro (&Qlaplace
);
10201 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10202 staticpro (&Qface_set_after_frame_default
);
10204 Fput (Qundefined_color
, Qerror_conditions
,
10205 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10206 Fput (Qundefined_color
, Qerror_message
,
10207 build_string ("Undefined color"));
10209 init_x_parm_symbols ();
10211 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10212 "List of directories to search for bitmap files for X.");
10213 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10215 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10216 "The shape of the pointer when over text.\n\
10217 Changing the value does not affect existing frames\n\
10218 unless you set the mouse color.");
10219 Vx_pointer_shape
= Qnil
;
10221 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10222 "The name Emacs uses to look up X resources.\n\
10223 `x-get-resource' uses this as the first component of the instance name\n\
10224 when requesting resource values.\n\
10225 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10226 was invoked, or to the value specified with the `-name' or `-rn'\n\
10227 switches, if present.\n\
10229 It may be useful to bind this variable locally around a call\n\
10230 to `x-get-resource'. See also the variable `x-resource-class'.");
10231 Vx_resource_name
= Qnil
;
10233 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10234 "The class Emacs uses to look up X resources.\n\
10235 `x-get-resource' uses this as the first component of the instance class\n\
10236 when requesting resource values.\n\
10237 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10239 Setting this variable permanently is not a reasonable thing to do,\n\
10240 but binding this variable locally around a call to `x-get-resource'\n\
10241 is a reasonable practice. See also the variable `x-resource-name'.");
10242 Vx_resource_class
= build_string (EMACS_CLASS
);
10244 #if 0 /* This doesn't really do anything. */
10245 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10246 "The shape of the pointer when not over text.\n\
10247 This variable takes effect when you create a new frame\n\
10248 or when you set the mouse color.");
10250 Vx_nontext_pointer_shape
= Qnil
;
10252 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10253 "The shape of the pointer when Emacs is busy.\n\
10254 This variable takes effect when you create a new frame\n\
10255 or when you set the mouse color.");
10256 Vx_busy_pointer_shape
= Qnil
;
10258 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10259 "Non-zero means Emacs displays a busy cursor on window systems.");
10260 display_busy_cursor_p
= 1;
10262 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10263 "*Seconds to wait before displaying a busy-cursor.\n\
10264 Value must be an integer or float.");
10265 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10267 #if 0 /* This doesn't really do anything. */
10268 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10269 "The shape of the pointer when over the mode line.\n\
10270 This variable takes effect when you create a new frame\n\
10271 or when you set the mouse color.");
10273 Vx_mode_pointer_shape
= Qnil
;
10275 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10276 &Vx_sensitive_text_pointer_shape
,
10277 "The shape of the pointer when over mouse-sensitive text.\n\
10278 This variable takes effect when you create a new frame\n\
10279 or when you set the mouse color.");
10280 Vx_sensitive_text_pointer_shape
= Qnil
;
10282 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10283 "A string indicating the foreground color of the cursor box.");
10284 Vx_cursor_fore_pixel
= Qnil
;
10286 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10287 "Non-nil if no X window manager is in use.\n\
10288 Emacs doesn't try to figure this out; this is always nil\n\
10289 unless you set it to something else.");
10290 /* We don't have any way to find this out, so set it to nil
10291 and maybe the user would like to set it to t. */
10292 Vx_no_window_manager
= Qnil
;
10294 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10295 &Vx_pixel_size_width_font_regexp
,
10296 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10298 Since Emacs gets width of a font matching with this regexp from\n\
10299 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10300 such a font. This is especially effective for such large fonts as\n\
10301 Chinese, Japanese, and Korean.");
10302 Vx_pixel_size_width_font_regexp
= Qnil
;
10304 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10305 "Time after which cached images are removed from the cache.\n\
10306 When an image has not been displayed this many seconds, remove it\n\
10307 from the image cache. Value must be an integer or nil with nil\n\
10308 meaning don't clear the cache.");
10309 Vimage_cache_eviction_delay
= make_number (30 * 60);
10311 #ifdef USE_X_TOOLKIT
10312 Fprovide (intern ("x-toolkit"));
10315 Fprovide (intern ("motif"));
10318 defsubr (&Sx_get_resource
);
10320 /* X window properties. */
10321 defsubr (&Sx_change_window_property
);
10322 defsubr (&Sx_delete_window_property
);
10323 defsubr (&Sx_window_property
);
10325 defsubr (&Sxw_display_color_p
);
10326 defsubr (&Sx_display_grayscale_p
);
10327 defsubr (&Sxw_color_defined_p
);
10328 defsubr (&Sxw_color_values
);
10329 defsubr (&Sx_server_max_request_size
);
10330 defsubr (&Sx_server_vendor
);
10331 defsubr (&Sx_server_version
);
10332 defsubr (&Sx_display_pixel_width
);
10333 defsubr (&Sx_display_pixel_height
);
10334 defsubr (&Sx_display_mm_width
);
10335 defsubr (&Sx_display_mm_height
);
10336 defsubr (&Sx_display_screens
);
10337 defsubr (&Sx_display_planes
);
10338 defsubr (&Sx_display_color_cells
);
10339 defsubr (&Sx_display_visual_class
);
10340 defsubr (&Sx_display_backing_store
);
10341 defsubr (&Sx_display_save_under
);
10342 defsubr (&Sx_parse_geometry
);
10343 defsubr (&Sx_create_frame
);
10344 defsubr (&Sx_open_connection
);
10345 defsubr (&Sx_close_connection
);
10346 defsubr (&Sx_display_list
);
10347 defsubr (&Sx_synchronize
);
10348 defsubr (&Sx_focus_frame
);
10350 /* Setting callback functions for fontset handler. */
10351 get_font_info_func
= x_get_font_info
;
10353 #if 0 /* This function pointer doesn't seem to be used anywhere.
10354 And the pointer assigned has the wrong type, anyway. */
10355 list_fonts_func
= x_list_fonts
;
10358 load_font_func
= x_load_font
;
10359 find_ccl_program_func
= x_find_ccl_program
;
10360 query_font_func
= x_query_font
;
10361 set_frame_fontset_func
= x_set_font
;
10362 check_window_system_func
= check_x
;
10365 Qxbm
= intern ("xbm");
10367 QCtype
= intern (":type");
10368 staticpro (&QCtype
);
10369 QCalgorithm
= intern (":algorithm");
10370 staticpro (&QCalgorithm
);
10371 QCheuristic_mask
= intern (":heuristic-mask");
10372 staticpro (&QCheuristic_mask
);
10373 QCcolor_symbols
= intern (":color-symbols");
10374 staticpro (&QCcolor_symbols
);
10375 QCascent
= intern (":ascent");
10376 staticpro (&QCascent
);
10377 QCmargin
= intern (":margin");
10378 staticpro (&QCmargin
);
10379 QCrelief
= intern (":relief");
10380 staticpro (&QCrelief
);
10381 Qpostscript
= intern ("postscript");
10382 staticpro (&Qpostscript
);
10383 QCloader
= intern (":loader");
10384 staticpro (&QCloader
);
10385 QCbounding_box
= intern (":bounding-box");
10386 staticpro (&QCbounding_box
);
10387 QCpt_width
= intern (":pt-width");
10388 staticpro (&QCpt_width
);
10389 QCpt_height
= intern (":pt-height");
10390 staticpro (&QCpt_height
);
10391 QCindex
= intern (":index");
10392 staticpro (&QCindex
);
10393 Qpbm
= intern ("pbm");
10397 Qxpm
= intern ("xpm");
10402 Qjpeg
= intern ("jpeg");
10403 staticpro (&Qjpeg
);
10407 Qtiff
= intern ("tiff");
10408 staticpro (&Qtiff
);
10412 Qgif
= intern ("gif");
10417 Qpng
= intern ("png");
10421 defsubr (&Sclear_image_cache
);
10423 busy_cursor_atimer
= NULL
;
10424 busy_cursor_shown_p
= 0;
10426 defsubr (&Sx_show_tip
);
10427 defsubr (&Sx_hide_tip
);
10428 staticpro (&tip_timer
);
10432 defsubr (&Sx_file_dialog
);
10440 image_types
= NULL
;
10441 Vimage_types
= Qnil
;
10443 define_image_type (&xbm_type
);
10444 define_image_type (&gs_type
);
10445 define_image_type (&pbm_type
);
10448 define_image_type (&xpm_type
);
10452 define_image_type (&jpeg_type
);
10456 define_image_type (&tiff_type
);
10460 define_image_type (&gif_type
);
10464 define_image_type (&png_type
);
10468 #endif /* HAVE_X_WINDOWS */