1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000
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"
45 #include "termhooks.h"
51 #include <sys/types.h>
55 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
56 #include "bitmaps/gray.xbm"
58 #include <X11/bitmaps/gray>
61 #include "[.bitmaps]gray.xbm"
65 #include <X11/Shell.h>
68 #include <X11/Xaw/Paned.h>
69 #include <X11/Xaw/Label.h>
70 #endif /* USE_MOTIF */
73 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
82 #include "../lwlib/lwlib.h"
86 #include <Xm/DialogS.h>
87 #include <Xm/FileSB.h>
90 /* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
93 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
95 extern void _XEditResCheckMessages ();
96 #endif /* R5 + Athena */
98 /* Unique id counter for widgets created by the Lucid Widget Library. */
100 extern LWLIB_ID widget_id_tick
;
103 /* This is part of a kludge--see lwlib/xlwmenu.c. */
104 extern XFontStruct
*xlwmenu_default_font
;
107 extern void free_frame_menubar ();
108 extern double atof ();
110 #endif /* USE_X_TOOLKIT */
112 #define min(a,b) ((a) < (b) ? (a) : (b))
113 #define max(a,b) ((a) > (b) ? (a) : (b))
116 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
118 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
121 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
122 it, and including `bitmaps/gray' more than once is a problem when
123 config.h defines `static' as an empty replacement string. */
125 int gray_bitmap_width
= gray_width
;
126 int gray_bitmap_height
= gray_height
;
127 unsigned char *gray_bitmap_bits
= gray_bits
;
129 /* The name we're using in resource queries. Most often "emacs". */
131 Lisp_Object Vx_resource_name
;
133 /* The application class we're using in resource queries.
136 Lisp_Object Vx_resource_class
;
138 /* Non-zero means we're allowed to display a busy cursor. */
140 int display_busy_cursor_p
;
142 /* The background and shape of the mouse pointer, and shape when not
143 over text or in the modeline. */
145 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
146 Lisp_Object Vx_busy_pointer_shape
;
148 /* The shape when over mouse-sensitive text. */
150 Lisp_Object Vx_sensitive_text_pointer_shape
;
152 /* Color of chars displayed in cursor box. */
154 Lisp_Object Vx_cursor_fore_pixel
;
156 /* Nonzero if using X. */
160 /* Non nil if no window manager is in use. */
162 Lisp_Object Vx_no_window_manager
;
164 /* Search path for bitmap files. */
166 Lisp_Object Vx_bitmap_file_path
;
168 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
170 Lisp_Object Vx_pixel_size_width_font_regexp
;
172 /* Evaluate this expression to rebuild the section of syms_of_xfns
173 that initializes and staticpros the symbols declared below. Note
174 that Emacs 18 has a bug that keeps C-x C-e from being able to
175 evaluate this expression.
178 ;; Accumulate a list of the symbols we want to initialize from the
179 ;; declarations at the top of the file.
180 (goto-char (point-min))
181 (search-forward "/\*&&& symbols declared here &&&*\/\n")
183 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
185 (cons (buffer-substring (match-beginning 1) (match-end 1))
188 (setq symbol-list (nreverse symbol-list))
189 ;; Delete the section of syms_of_... where we initialize the symbols.
190 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
191 (let ((start (point)))
192 (while (looking-at "^ Q")
194 (kill-region start (point)))
195 ;; Write a new symbol initialization section.
197 (insert (format " %s = intern (\"" (car symbol-list)))
198 (let ((start (point)))
199 (insert (substring (car symbol-list) 1))
200 (subst-char-in-region start (point) ?_ ?-))
201 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
202 (setq symbol-list (cdr symbol-list)))))
206 /*&&& symbols declared here &&&*/
207 Lisp_Object Qauto_raise
;
208 Lisp_Object Qauto_lower
;
210 Lisp_Object Qborder_color
;
211 Lisp_Object Qborder_width
;
213 Lisp_Object Qcursor_color
;
214 Lisp_Object Qcursor_type
;
215 Lisp_Object Qgeometry
;
216 Lisp_Object Qicon_left
;
217 Lisp_Object Qicon_top
;
218 Lisp_Object Qicon_type
;
219 Lisp_Object Qicon_name
;
220 Lisp_Object Qinternal_border_width
;
223 Lisp_Object Qmouse_color
;
225 Lisp_Object Qouter_window_id
;
226 Lisp_Object Qparent_id
;
227 Lisp_Object Qscroll_bar_width
;
228 Lisp_Object Qsuppress_icon
;
229 extern Lisp_Object Qtop
;
230 Lisp_Object Qundefined_color
;
231 Lisp_Object Qvertical_scroll_bars
;
232 Lisp_Object Qvisibility
;
233 Lisp_Object Qwindow_id
;
234 Lisp_Object Qx_frame_parameter
;
235 Lisp_Object Qx_resource_name
;
236 Lisp_Object Quser_position
;
237 Lisp_Object Quser_size
;
238 extern Lisp_Object Qdisplay
;
239 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
240 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
241 Lisp_Object Qcompound_text
;
243 /* The below are defined in frame.c. */
245 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
246 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
247 extern Lisp_Object Qtool_bar_lines
;
249 extern Lisp_Object Vwindow_system_version
;
251 Lisp_Object Qface_set_after_frame_default
;
254 /* Error if we are not connected to X. */
260 error ("X windows are not in use or not initialized");
263 /* Nonzero if we can use mouse menus.
264 You should not call this unless HAVE_MENUS is defined. */
272 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
273 and checking validity for X. */
276 check_x_frame (frame
)
282 frame
= selected_frame
;
283 CHECK_LIVE_FRAME (frame
, 0);
286 error ("Non-X frame used");
290 /* Let the user specify an X display with a frame.
291 nil stands for the selected frame--or, if that is not an X frame,
292 the first X display on the list. */
294 static struct x_display_info
*
295 check_x_display_info (frame
)
298 struct x_display_info
*dpyinfo
= NULL
;
302 struct frame
*sf
= XFRAME (selected_frame
);
304 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
305 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
306 else if (x_display_list
!= 0)
307 dpyinfo
= x_display_list
;
309 error ("X windows are not in use or not initialized");
311 else if (STRINGP (frame
))
312 dpyinfo
= x_display_info_for_name (frame
);
317 CHECK_LIVE_FRAME (frame
, 0);
320 error ("Non-X frame used");
321 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
328 /* Return the Emacs frame-object corresponding to an X window.
329 It could be the frame's main window or an icon window. */
331 /* This function can be called during GC, so use GC_xxx type test macros. */
334 x_window_to_frame (dpyinfo
, wdesc
)
335 struct x_display_info
*dpyinfo
;
338 Lisp_Object tail
, frame
;
341 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
344 if (!GC_FRAMEP (frame
))
347 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
349 if (f
->output_data
.x
->busy_window
== wdesc
)
352 if ((f
->output_data
.x
->edit_widget
353 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
354 /* A tooltip frame? */
355 || (!f
->output_data
.x
->edit_widget
356 && FRAME_X_WINDOW (f
) == wdesc
)
357 || f
->output_data
.x
->icon_desc
== wdesc
)
359 #else /* not USE_X_TOOLKIT */
360 if (FRAME_X_WINDOW (f
) == wdesc
361 || f
->output_data
.x
->icon_desc
== wdesc
)
363 #endif /* not USE_X_TOOLKIT */
369 /* Like x_window_to_frame but also compares the window with the widget's
373 x_any_window_to_frame (dpyinfo
, wdesc
)
374 struct x_display_info
*dpyinfo
;
377 Lisp_Object tail
, frame
;
378 struct frame
*f
, *found
;
382 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
385 if (!GC_FRAMEP (frame
))
389 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
391 /* This frame matches if the window is any of its widgets. */
392 x
= f
->output_data
.x
;
393 if (x
->busy_window
== wdesc
)
397 if (wdesc
== XtWindow (x
->widget
)
398 || wdesc
== XtWindow (x
->column_widget
)
399 || wdesc
== XtWindow (x
->edit_widget
))
401 /* Match if the window is this frame's menubar. */
402 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
405 else if (FRAME_X_WINDOW (f
) == wdesc
)
406 /* A tooltip frame. */
414 /* Likewise, but exclude the menu bar widget. */
417 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
418 struct x_display_info
*dpyinfo
;
421 Lisp_Object tail
, frame
;
425 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
428 if (!GC_FRAMEP (frame
))
431 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
433 x
= f
->output_data
.x
;
434 /* This frame matches if the window is any of its widgets. */
435 if (x
->busy_window
== wdesc
)
439 if (wdesc
== XtWindow (x
->widget
)
440 || wdesc
== XtWindow (x
->column_widget
)
441 || wdesc
== XtWindow (x
->edit_widget
))
444 else if (FRAME_X_WINDOW (f
) == wdesc
)
445 /* A tooltip frame. */
451 /* Likewise, but consider only the menu bar widget. */
454 x_menubar_window_to_frame (dpyinfo
, wdesc
)
455 struct x_display_info
*dpyinfo
;
458 Lisp_Object tail
, frame
;
462 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
465 if (!GC_FRAMEP (frame
))
468 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
470 x
= f
->output_data
.x
;
471 /* Match if the window is this frame's menubar. */
472 if (x
->menubar_widget
473 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
479 /* Return the frame whose principal (outermost) window is WDESC.
480 If WDESC is some other (smaller) window, we return 0. */
483 x_top_window_to_frame (dpyinfo
, wdesc
)
484 struct x_display_info
*dpyinfo
;
487 Lisp_Object tail
, frame
;
491 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
494 if (!GC_FRAMEP (frame
))
497 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
499 x
= f
->output_data
.x
;
503 /* This frame matches if the window is its topmost widget. */
504 if (wdesc
== XtWindow (x
->widget
))
506 #if 0 /* I don't know why it did this,
507 but it seems logically wrong,
508 and it causes trouble for MapNotify events. */
509 /* Match if the window is this frame's menubar. */
510 if (x
->menubar_widget
511 && wdesc
== XtWindow (x
->menubar_widget
))
515 else if (FRAME_X_WINDOW (f
) == wdesc
)
521 #endif /* USE_X_TOOLKIT */
525 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
526 id, which is just an int that this section returns. Bitmaps are
527 reference counted so they can be shared among frames.
529 Bitmap indices are guaranteed to be > 0, so a negative number can
530 be used to indicate no bitmap.
532 If you use x_create_bitmap_from_data, then you must keep track of
533 the bitmaps yourself. That is, creating a bitmap from the same
534 data more than once will not be caught. */
537 /* Functions to access the contents of a bitmap, given an id. */
540 x_bitmap_height (f
, id
)
544 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
548 x_bitmap_width (f
, id
)
552 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
556 x_bitmap_pixmap (f
, id
)
560 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
564 /* Allocate a new bitmap record. Returns index of new record. */
567 x_allocate_bitmap_record (f
)
570 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
573 if (dpyinfo
->bitmaps
== NULL
)
575 dpyinfo
->bitmaps_size
= 10;
577 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
578 dpyinfo
->bitmaps_last
= 1;
582 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
583 return ++dpyinfo
->bitmaps_last
;
585 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
586 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
589 dpyinfo
->bitmaps_size
*= 2;
591 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
592 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
593 return ++dpyinfo
->bitmaps_last
;
596 /* Add one reference to the reference count of the bitmap with id ID. */
599 x_reference_bitmap (f
, id
)
603 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
606 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
609 x_create_bitmap_from_data (f
, bits
, width
, height
)
612 unsigned int width
, height
;
614 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
618 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
619 bits
, width
, height
);
624 id
= x_allocate_bitmap_record (f
);
625 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
626 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
627 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
628 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
629 dpyinfo
->bitmaps
[id
- 1].height
= height
;
630 dpyinfo
->bitmaps
[id
- 1].width
= width
;
635 /* Create bitmap from file FILE for frame F. */
638 x_create_bitmap_from_file (f
, file
)
642 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
643 unsigned int width
, height
;
645 int xhot
, yhot
, result
, id
;
650 /* Look for an existing bitmap with the same name. */
651 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
653 if (dpyinfo
->bitmaps
[id
].refcount
654 && dpyinfo
->bitmaps
[id
].file
655 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
657 ++dpyinfo
->bitmaps
[id
].refcount
;
662 /* Search bitmap-file-path for the file, if appropriate. */
663 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
666 /* XReadBitmapFile won't handle magic file names. */
671 filename
= (char *) XSTRING (found
)->data
;
673 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
674 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
675 if (result
!= BitmapSuccess
)
678 id
= x_allocate_bitmap_record (f
);
679 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
680 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
681 dpyinfo
->bitmaps
[id
- 1].file
682 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
683 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
684 dpyinfo
->bitmaps
[id
- 1].height
= height
;
685 dpyinfo
->bitmaps
[id
- 1].width
= width
;
686 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
691 /* Remove reference to bitmap with id number ID. */
694 x_destroy_bitmap (f
, id
)
698 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
702 --dpyinfo
->bitmaps
[id
- 1].refcount
;
703 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
706 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
707 if (dpyinfo
->bitmaps
[id
- 1].file
)
709 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
710 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
717 /* Free all the bitmaps for the display specified by DPYINFO. */
720 x_destroy_all_bitmaps (dpyinfo
)
721 struct x_display_info
*dpyinfo
;
724 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
725 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
727 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
728 if (dpyinfo
->bitmaps
[i
].file
)
729 xfree (dpyinfo
->bitmaps
[i
].file
);
731 dpyinfo
->bitmaps_last
= 0;
734 /* Connect the frame-parameter names for X frames
735 to the ways of passing the parameter values to the window system.
737 The name of a parameter, as a Lisp symbol,
738 has an `x-frame-parameter' property which is an integer in Lisp
739 that is an index in this table. */
741 struct x_frame_parm_table
744 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 static void x_disable_image
P_ ((struct frame
*, struct image
*));
748 static void x_create_im
P_ ((struct frame
*));
749 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
762 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
767 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
775 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
777 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
782 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
783 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
785 static void init_color_table
P_ ((void));
786 static void free_color_table
P_ ((void));
787 static unsigned long *colors_in_color_table
P_ ((int *n
));
788 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
789 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
793 static struct x_frame_parm_table x_frame_parms
[] =
795 "auto-raise", x_set_autoraise
,
796 "auto-lower", x_set_autolower
,
797 "background-color", x_set_background_color
,
798 "border-color", x_set_border_color
,
799 "border-width", x_set_border_width
,
800 "cursor-color", x_set_cursor_color
,
801 "cursor-type", x_set_cursor_type
,
803 "foreground-color", x_set_foreground_color
,
804 "icon-name", x_set_icon_name
,
805 "icon-type", x_set_icon_type
,
806 "internal-border-width", x_set_internal_border_width
,
807 "menu-bar-lines", x_set_menu_bar_lines
,
808 "mouse-color", x_set_mouse_color
,
809 "name", x_explicitly_set_name
,
810 "scroll-bar-width", x_set_scroll_bar_width
,
811 "title", x_set_title
,
812 "unsplittable", x_set_unsplittable
,
813 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
814 "visibility", x_set_visibility
,
815 "tool-bar-lines", x_set_tool_bar_lines
,
816 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
817 "scroll-bar-background", x_set_scroll_bar_background
,
818 "screen-gamma", x_set_screen_gamma
,
819 "line-spacing", x_set_line_spacing
822 /* Attach the `x-frame-parameter' properties to
823 the Lisp symbol names of parameters relevant to X. */
826 init_x_parm_symbols ()
830 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
831 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
835 /* Change the parameters of frame F as specified by ALIST.
836 If a parameter is not specially recognized, do nothing special;
837 otherwise call the `x_set_...' function for that parameter.
838 Except for certain geometry properties, always call store_frame_param
839 to store the new value in the parameter alist. */
842 x_set_frame_parameters (f
, alist
)
848 /* If both of these parameters are present, it's more efficient to
849 set them both at once. So we wait until we've looked at the
850 entire list before we set them. */
854 Lisp_Object left
, top
;
856 /* Same with these. */
857 Lisp_Object icon_left
, icon_top
;
859 /* Record in these vectors all the parms specified. */
863 int left_no_change
= 0, top_no_change
= 0;
864 int icon_left_no_change
= 0, icon_top_no_change
= 0;
866 struct gcpro gcpro1
, gcpro2
;
869 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
872 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
873 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
875 /* Extract parm names and values into those vectors. */
878 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
883 parms
[i
] = Fcar (elt
);
884 values
[i
] = Fcdr (elt
);
887 /* TAIL and ALIST are not used again below here. */
890 GCPRO2 (*parms
, *values
);
894 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
895 because their values appear in VALUES and strings are not valid. */
896 top
= left
= Qunbound
;
897 icon_left
= icon_top
= Qunbound
;
899 /* Provide default values for HEIGHT and WIDTH. */
900 if (FRAME_NEW_WIDTH (f
))
901 width
= FRAME_NEW_WIDTH (f
);
903 width
= FRAME_WIDTH (f
);
905 if (FRAME_NEW_HEIGHT (f
))
906 height
= FRAME_NEW_HEIGHT (f
);
908 height
= FRAME_HEIGHT (f
);
910 /* Process foreground_color and background_color before anything else.
911 They are independent of other properties, but other properties (e.g.,
912 cursor_color) are dependent upon them. */
913 for (p
= 0; p
< i
; p
++)
915 Lisp_Object prop
, val
;
919 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
921 register Lisp_Object param_index
, old_value
;
923 param_index
= Fget (prop
, Qx_frame_parameter
);
924 old_value
= get_frame_param (f
, prop
);
925 store_frame_param (f
, prop
, val
);
926 if (NATNUMP (param_index
)
927 && (XFASTINT (param_index
)
928 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
929 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
933 /* Now process them in reverse of specified order. */
934 for (i
--; i
>= 0; i
--)
936 Lisp_Object prop
, val
;
941 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
942 width
= XFASTINT (val
);
943 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
944 height
= XFASTINT (val
);
945 else if (EQ (prop
, Qtop
))
947 else if (EQ (prop
, Qleft
))
949 else if (EQ (prop
, Qicon_top
))
951 else if (EQ (prop
, Qicon_left
))
953 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
954 /* Processed above. */
958 register Lisp_Object param_index
, old_value
;
960 param_index
= Fget (prop
, Qx_frame_parameter
);
961 old_value
= get_frame_param (f
, prop
);
962 store_frame_param (f
, prop
, val
);
963 if (NATNUMP (param_index
)
964 && (XFASTINT (param_index
)
965 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
966 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
970 /* Don't die if just one of these was set. */
971 if (EQ (left
, Qunbound
))
974 if (f
->output_data
.x
->left_pos
< 0)
975 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
977 XSETINT (left
, f
->output_data
.x
->left_pos
);
979 if (EQ (top
, Qunbound
))
982 if (f
->output_data
.x
->top_pos
< 0)
983 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
985 XSETINT (top
, f
->output_data
.x
->top_pos
);
988 /* If one of the icon positions was not set, preserve or default it. */
989 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
991 icon_left_no_change
= 1;
992 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
993 if (NILP (icon_left
))
994 XSETINT (icon_left
, 0);
996 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
998 icon_top_no_change
= 1;
999 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1000 if (NILP (icon_top
))
1001 XSETINT (icon_top
, 0);
1004 /* Don't set these parameters unless they've been explicitly
1005 specified. The window might be mapped or resized while we're in
1006 this function, and we don't want to override that unless the lisp
1007 code has asked for it.
1009 Don't set these parameters unless they actually differ from the
1010 window's current parameters; the window may not actually exist
1015 check_frame_size (f
, &height
, &width
);
1017 XSETFRAME (frame
, f
);
1019 if (width
!= FRAME_WIDTH (f
)
1020 || height
!= FRAME_HEIGHT (f
)
1021 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1022 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1024 if ((!NILP (left
) || !NILP (top
))
1025 && ! (left_no_change
&& top_no_change
)
1026 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1027 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1032 /* Record the signs. */
1033 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1034 if (EQ (left
, Qminus
))
1035 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1036 else if (INTEGERP (left
))
1038 leftpos
= XINT (left
);
1040 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1042 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1043 && CONSP (XCDR (left
))
1044 && INTEGERP (XCAR (XCDR (left
))))
1046 leftpos
= - XINT (XCAR (XCDR (left
)));
1047 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1049 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1050 && CONSP (XCDR (left
))
1051 && INTEGERP (XCAR (XCDR (left
))))
1053 leftpos
= XINT (XCAR (XCDR (left
)));
1056 if (EQ (top
, Qminus
))
1057 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1058 else if (INTEGERP (top
))
1060 toppos
= XINT (top
);
1062 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1064 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1065 && CONSP (XCDR (top
))
1066 && INTEGERP (XCAR (XCDR (top
))))
1068 toppos
= - XINT (XCAR (XCDR (top
)));
1069 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1071 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1072 && CONSP (XCDR (top
))
1073 && INTEGERP (XCAR (XCDR (top
))))
1075 toppos
= XINT (XCAR (XCDR (top
)));
1079 /* Store the numeric value of the position. */
1080 f
->output_data
.x
->top_pos
= toppos
;
1081 f
->output_data
.x
->left_pos
= leftpos
;
1083 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1085 /* Actually set that position, and convert to absolute. */
1086 x_set_offset (f
, leftpos
, toppos
, -1);
1089 if ((!NILP (icon_left
) || !NILP (icon_top
))
1090 && ! (icon_left_no_change
&& icon_top_no_change
))
1091 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1097 /* Store the screen positions of frame F into XPTR and YPTR.
1098 These are the positions of the containing window manager window,
1099 not Emacs's own window. */
1102 x_real_positions (f
, xptr
, yptr
)
1109 /* This is pretty gross, but seems to be the easiest way out of
1110 the problem that arises when restarting window-managers. */
1112 #ifdef USE_X_TOOLKIT
1113 Window outer
= (f
->output_data
.x
->widget
1114 ? XtWindow (f
->output_data
.x
->widget
)
1115 : FRAME_X_WINDOW (f
));
1117 Window outer
= f
->output_data
.x
->window_desc
;
1119 Window tmp_root_window
;
1120 Window
*tmp_children
;
1121 unsigned int tmp_nchildren
;
1125 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1126 Window outer_window
;
1128 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1129 &f
->output_data
.x
->parent_desc
,
1130 &tmp_children
, &tmp_nchildren
);
1131 XFree ((char *) tmp_children
);
1135 /* Find the position of the outside upper-left corner of
1136 the inner window, with respect to the outer window. */
1137 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1138 outer_window
= f
->output_data
.x
->parent_desc
;
1140 outer_window
= outer
;
1142 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1144 /* From-window, to-window. */
1146 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1148 /* From-position, to-position. */
1149 0, 0, &win_x
, &win_y
,
1154 /* It is possible for the window returned by the XQueryNotify
1155 to become invalid by the time we call XTranslateCoordinates.
1156 That can happen when you restart some window managers.
1157 If so, we get an error in XTranslateCoordinates.
1158 Detect that and try the whole thing over. */
1159 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1161 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1165 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1172 /* Insert a description of internally-recorded parameters of frame X
1173 into the parameter alist *ALISTPTR that is to be given to the user.
1174 Only parameters that are specific to the X window system
1175 and whose values are not correctly recorded in the frame's
1176 param_alist need to be considered here. */
1179 x_report_frame_params (f
, alistptr
)
1181 Lisp_Object
*alistptr
;
1186 /* Represent negative positions (off the top or left screen edge)
1187 in a way that Fmodify_frame_parameters will understand correctly. */
1188 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1189 if (f
->output_data
.x
->left_pos
>= 0)
1190 store_in_alist (alistptr
, Qleft
, tem
);
1192 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1194 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1195 if (f
->output_data
.x
->top_pos
>= 0)
1196 store_in_alist (alistptr
, Qtop
, tem
);
1198 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1200 store_in_alist (alistptr
, Qborder_width
,
1201 make_number (f
->output_data
.x
->border_width
));
1202 store_in_alist (alistptr
, Qinternal_border_width
,
1203 make_number (f
->output_data
.x
->internal_border_width
));
1204 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1205 store_in_alist (alistptr
, Qwindow_id
,
1206 build_string (buf
));
1207 #ifdef USE_X_TOOLKIT
1208 /* Tooltip frame may not have this widget. */
1209 if (f
->output_data
.x
->widget
)
1211 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1212 store_in_alist (alistptr
, Qouter_window_id
,
1213 build_string (buf
));
1214 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1215 FRAME_SAMPLE_VISIBILITY (f
);
1216 store_in_alist (alistptr
, Qvisibility
,
1217 (FRAME_VISIBLE_P (f
) ? Qt
1218 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1219 store_in_alist (alistptr
, Qdisplay
,
1220 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1222 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1225 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1226 store_in_alist (alistptr
, Qparent_id
, tem
);
1231 /* Gamma-correct COLOR on frame F. */
1234 gamma_correct (f
, color
)
1240 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1241 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1242 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1247 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1248 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1249 allocate the color. Value is zero if COLOR_NAME is invalid, or
1250 no color could be allocated. */
1253 x_defined_color (f
, color_name
, color
, alloc_p
)
1260 Display
*dpy
= FRAME_X_DISPLAY (f
);
1261 Colormap cmap
= FRAME_X_COLORMAP (f
);
1264 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1265 if (success_p
&& alloc_p
)
1266 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1273 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1274 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1275 Signal an error if color can't be allocated. */
1278 x_decode_color (f
, color_name
, mono_color
)
1280 Lisp_Object color_name
;
1285 CHECK_STRING (color_name
, 0);
1287 #if 0 /* Don't do this. It's wrong when we're not using the default
1288 colormap, it makes freeing difficult, and it's probably not
1289 an important optimization. */
1290 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1291 return BLACK_PIX_DEFAULT (f
);
1292 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1293 return WHITE_PIX_DEFAULT (f
);
1296 /* Return MONO_COLOR for monochrome frames. */
1297 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1300 /* x_defined_color is responsible for coping with failures
1301 by looking for a near-miss. */
1302 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1305 return Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1306 Fcons (color_name
, Qnil
)));
1311 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1312 the previous value of that parameter, NEW_VALUE is the new value. */
1315 x_set_line_spacing (f
, new_value
, old_value
)
1317 Lisp_Object new_value
, old_value
;
1319 if (NILP (new_value
))
1320 f
->extra_line_spacing
= 0;
1321 else if (NATNUMP (new_value
))
1322 f
->extra_line_spacing
= XFASTINT (new_value
);
1324 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1325 Fcons (new_value
, Qnil
)));
1326 if (FRAME_VISIBLE_P (f
))
1331 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1332 the previous value of that parameter, NEW_VALUE is the new value. */
1335 x_set_screen_gamma (f
, new_value
, old_value
)
1337 Lisp_Object new_value
, old_value
;
1339 if (NILP (new_value
))
1341 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1342 /* The value 0.4545 is the normal viewing gamma. */
1343 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1345 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1346 Fcons (new_value
, Qnil
)));
1348 clear_face_cache (0);
1352 /* Functions called only from `x_set_frame_param'
1353 to set individual parameters.
1355 If FRAME_X_WINDOW (f) is 0,
1356 the frame is being created and its X-window does not exist yet.
1357 In that case, just record the parameter's new value
1358 in the standard place; do not attempt to change the window. */
1361 x_set_foreground_color (f
, arg
, oldval
)
1363 Lisp_Object arg
, oldval
;
1366 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1368 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1369 f
->output_data
.x
->foreground_pixel
= pixel
;
1371 if (FRAME_X_WINDOW (f
) != 0)
1374 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1375 f
->output_data
.x
->foreground_pixel
);
1376 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1377 f
->output_data
.x
->foreground_pixel
);
1379 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1380 if (FRAME_VISIBLE_P (f
))
1386 x_set_background_color (f
, arg
, oldval
)
1388 Lisp_Object arg
, oldval
;
1391 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1393 unload_color (f
, f
->output_data
.x
->background_pixel
);
1394 f
->output_data
.x
->background_pixel
= pixel
;
1396 if (FRAME_X_WINDOW (f
) != 0)
1399 /* The main frame area. */
1400 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1401 f
->output_data
.x
->background_pixel
);
1402 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1403 f
->output_data
.x
->background_pixel
);
1404 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1405 f
->output_data
.x
->background_pixel
);
1406 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1407 f
->output_data
.x
->background_pixel
);
1410 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1411 bar
= XSCROLL_BAR (bar
)->next
)
1412 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1413 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1414 f
->output_data
.x
->background_pixel
);
1418 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1420 if (FRAME_VISIBLE_P (f
))
1426 x_set_mouse_color (f
, arg
, oldval
)
1428 Lisp_Object arg
, oldval
;
1430 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1433 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1434 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1436 /* Don't let pointers be invisible. */
1437 if (mask_color
== pixel
1438 && mask_color
== f
->output_data
.x
->background_pixel
)
1439 pixel
= f
->output_data
.x
->foreground_pixel
;
1441 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1442 f
->output_data
.x
->mouse_pixel
= pixel
;
1446 /* It's not okay to crash if the user selects a screwy cursor. */
1447 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1449 if (!EQ (Qnil
, Vx_pointer_shape
))
1451 CHECK_NUMBER (Vx_pointer_shape
, 0);
1452 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1455 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1456 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1458 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1460 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1461 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1462 XINT (Vx_nontext_pointer_shape
));
1465 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1466 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1468 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1470 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1471 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1472 XINT (Vx_busy_pointer_shape
));
1475 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1476 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1478 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1479 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1481 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1482 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1483 XINT (Vx_mode_pointer_shape
));
1486 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1487 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1489 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1491 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1493 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1494 XINT (Vx_sensitive_text_pointer_shape
));
1497 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1499 /* Check and report errors with the above calls. */
1500 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1501 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1504 XColor fore_color
, back_color
;
1506 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1507 back_color
.pixel
= mask_color
;
1508 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1510 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1512 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1513 &fore_color
, &back_color
);
1514 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1515 &fore_color
, &back_color
);
1516 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1517 &fore_color
, &back_color
);
1518 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1519 &fore_color
, &back_color
);
1520 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1521 &fore_color
, &back_color
);
1524 if (FRAME_X_WINDOW (f
) != 0)
1525 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1527 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1528 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1529 f
->output_data
.x
->text_cursor
= cursor
;
1531 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1532 && f
->output_data
.x
->nontext_cursor
!= 0)
1533 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1534 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1536 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1537 && f
->output_data
.x
->busy_cursor
!= 0)
1538 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1539 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1541 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1542 && f
->output_data
.x
->modeline_cursor
!= 0)
1543 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1544 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1546 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1547 && f
->output_data
.x
->cross_cursor
!= 0)
1548 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1549 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1551 XFlush (FRAME_X_DISPLAY (f
));
1554 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1558 x_set_cursor_color (f
, arg
, oldval
)
1560 Lisp_Object arg
, oldval
;
1562 unsigned long fore_pixel
, pixel
;
1563 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1565 if (!NILP (Vx_cursor_fore_pixel
))
1567 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1568 WHITE_PIX_DEFAULT (f
));
1569 fore_pixel_allocated_p
= 1;
1572 fore_pixel
= f
->output_data
.x
->background_pixel
;
1574 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1575 pixel_allocated_p
= 1;
1577 /* Make sure that the cursor color differs from the background color. */
1578 if (pixel
== f
->output_data
.x
->background_pixel
)
1580 if (pixel_allocated_p
)
1582 x_free_colors (f
, &pixel
, 1);
1583 pixel_allocated_p
= 0;
1586 pixel
= f
->output_data
.x
->mouse_pixel
;
1587 if (pixel
== fore_pixel
)
1589 if (fore_pixel_allocated_p
)
1591 x_free_colors (f
, &fore_pixel
, 1);
1592 fore_pixel_allocated_p
= 0;
1594 fore_pixel
= f
->output_data
.x
->background_pixel
;
1598 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1599 if (!fore_pixel_allocated_p
)
1600 fore_pixel
= x_copy_color (f
, fore_pixel
);
1601 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1603 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1604 if (!pixel_allocated_p
)
1605 pixel
= x_copy_color (f
, pixel
);
1606 f
->output_data
.x
->cursor_pixel
= pixel
;
1608 if (FRAME_X_WINDOW (f
) != 0)
1611 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1612 f
->output_data
.x
->cursor_pixel
);
1613 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1617 if (FRAME_VISIBLE_P (f
))
1619 x_update_cursor (f
, 0);
1620 x_update_cursor (f
, 1);
1624 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1627 /* Set the border-color of frame F to value described by ARG.
1628 ARG can be a string naming a color.
1629 The border-color is used for the border that is drawn by the X server.
1630 Note that this does not fully take effect if done before
1631 F has an x-window; it must be redone when the window is created.
1633 Note: this is done in two routines because of the way X10 works.
1635 Note: under X11, this is normally the province of the window manager,
1636 and so emacs' border colors may be overridden. */
1639 x_set_border_color (f
, arg
, oldval
)
1641 Lisp_Object arg
, oldval
;
1645 CHECK_STRING (arg
, 0);
1646 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1647 x_set_border_pixel (f
, pix
);
1648 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1651 /* Set the border-color of frame F to pixel value PIX.
1652 Note that this does not fully take effect if done before
1653 F has an x-window. */
1656 x_set_border_pixel (f
, pix
)
1660 unload_color (f
, f
->output_data
.x
->border_pixel
);
1661 f
->output_data
.x
->border_pixel
= pix
;
1663 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1666 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1667 (unsigned long)pix
);
1670 if (FRAME_VISIBLE_P (f
))
1676 /* Value is the internal representation of the specified cursor type
1677 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1678 of the bar cursor. */
1680 enum text_cursor_kinds
1681 x_specified_cursor_type (arg
, width
)
1685 enum text_cursor_kinds type
;
1692 else if (CONSP (arg
)
1693 && EQ (XCAR (arg
), Qbar
)
1694 && INTEGERP (XCDR (arg
))
1695 && XINT (XCDR (arg
)) >= 0)
1698 *width
= XINT (XCDR (arg
));
1700 else if (NILP (arg
))
1703 /* Treat anything unknown as "box cursor".
1704 It was bad to signal an error; people have trouble fixing
1705 .Xdefaults with Emacs, when it has something bad in it. */
1706 type
= FILLED_BOX_CURSOR
;
1712 x_set_cursor_type (f
, arg
, oldval
)
1714 Lisp_Object arg
, oldval
;
1718 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1719 f
->output_data
.x
->cursor_width
= width
;
1721 /* Make sure the cursor gets redrawn. This is overkill, but how
1722 often do people change cursor types? */
1723 update_mode_lines
++;
1727 x_set_icon_type (f
, arg
, oldval
)
1729 Lisp_Object arg
, oldval
;
1735 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1738 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1743 result
= x_text_icon (f
,
1744 (char *) XSTRING ((!NILP (f
->icon_name
)
1748 result
= x_bitmap_icon (f
, arg
);
1753 error ("No icon window available");
1756 XFlush (FRAME_X_DISPLAY (f
));
1760 /* Return non-nil if frame F wants a bitmap icon. */
1768 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1776 x_set_icon_name (f
, arg
, oldval
)
1778 Lisp_Object arg
, oldval
;
1784 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1787 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1792 if (f
->output_data
.x
->icon_bitmap
!= 0)
1797 result
= x_text_icon (f
,
1798 (char *) XSTRING ((!NILP (f
->icon_name
)
1807 error ("No icon window available");
1810 XFlush (FRAME_X_DISPLAY (f
));
1815 x_set_font (f
, arg
, oldval
)
1817 Lisp_Object arg
, oldval
;
1820 Lisp_Object fontset_name
;
1823 CHECK_STRING (arg
, 1);
1825 fontset_name
= Fquery_fontset (arg
, Qnil
);
1828 result
= (STRINGP (fontset_name
)
1829 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1830 : x_new_font (f
, XSTRING (arg
)->data
));
1833 if (EQ (result
, Qnil
))
1834 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1835 else if (EQ (result
, Qt
))
1836 error ("The characters of the given font have varying widths");
1837 else if (STRINGP (result
))
1839 store_frame_param (f
, Qfont
, result
);
1840 recompute_basic_faces (f
);
1845 do_pending_window_change (0);
1847 /* Don't call `face-set-after-frame-default' when faces haven't been
1848 initialized yet. This is the case when called from
1849 Fx_create_frame. In that case, the X widget or window doesn't
1850 exist either, and we can end up in x_report_frame_params with a
1851 null widget which gives a segfault. */
1852 if (FRAME_FACE_CACHE (f
))
1854 XSETFRAME (frame
, f
);
1855 call1 (Qface_set_after_frame_default
, frame
);
1860 x_set_border_width (f
, arg
, oldval
)
1862 Lisp_Object arg
, oldval
;
1864 CHECK_NUMBER (arg
, 0);
1866 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1869 if (FRAME_X_WINDOW (f
) != 0)
1870 error ("Cannot change the border width of a window");
1872 f
->output_data
.x
->border_width
= XINT (arg
);
1876 x_set_internal_border_width (f
, arg
, oldval
)
1878 Lisp_Object arg
, oldval
;
1880 int old
= f
->output_data
.x
->internal_border_width
;
1882 CHECK_NUMBER (arg
, 0);
1883 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1884 if (f
->output_data
.x
->internal_border_width
< 0)
1885 f
->output_data
.x
->internal_border_width
= 0;
1887 #ifdef USE_X_TOOLKIT
1888 if (f
->output_data
.x
->edit_widget
)
1889 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1892 if (f
->output_data
.x
->internal_border_width
== old
)
1895 if (FRAME_X_WINDOW (f
) != 0)
1897 x_set_window_size (f
, 0, f
->width
, f
->height
);
1898 SET_FRAME_GARBAGED (f
);
1899 do_pending_window_change (0);
1904 x_set_visibility (f
, value
, oldval
)
1906 Lisp_Object value
, oldval
;
1909 XSETFRAME (frame
, f
);
1912 Fmake_frame_invisible (frame
, Qt
);
1913 else if (EQ (value
, Qicon
))
1914 Ficonify_frame (frame
);
1916 Fmake_frame_visible (frame
);
1920 x_set_menu_bar_lines_1 (window
, n
)
1924 struct window
*w
= XWINDOW (window
);
1926 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1927 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1929 if (INTEGERP (w
->orig_top
))
1930 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1931 if (INTEGERP (w
->orig_height
))
1932 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1934 /* Handle just the top child in a vertical split. */
1935 if (!NILP (w
->vchild
))
1936 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1938 /* Adjust all children in a horizontal split. */
1939 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1941 w
= XWINDOW (window
);
1942 x_set_menu_bar_lines_1 (window
, n
);
1947 x_set_menu_bar_lines (f
, value
, oldval
)
1949 Lisp_Object value
, oldval
;
1952 #ifndef USE_X_TOOLKIT
1953 int olines
= FRAME_MENU_BAR_LINES (f
);
1956 /* Right now, menu bars don't work properly in minibuf-only frames;
1957 most of the commands try to apply themselves to the minibuffer
1958 frame itself, and get an error because you can't switch buffers
1959 in or split the minibuffer window. */
1960 if (FRAME_MINIBUF_ONLY_P (f
))
1963 if (INTEGERP (value
))
1964 nlines
= XINT (value
);
1968 /* Make sure we redisplay all windows in this frame. */
1969 windows_or_buffers_changed
++;
1971 #ifdef USE_X_TOOLKIT
1972 FRAME_MENU_BAR_LINES (f
) = 0;
1975 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1976 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1977 /* Make sure next redisplay shows the menu bar. */
1978 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1982 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1983 free_frame_menubar (f
);
1984 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1986 f
->output_data
.x
->menubar_widget
= 0;
1988 #else /* not USE_X_TOOLKIT */
1989 FRAME_MENU_BAR_LINES (f
) = nlines
;
1990 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1991 #endif /* not USE_X_TOOLKIT */
1996 /* Set the number of lines used for the tool bar of frame F to VALUE.
1997 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1998 is the old number of tool bar lines. This function changes the
1999 height of all windows on frame F to match the new tool bar height.
2000 The frame's height doesn't change. */
2003 x_set_tool_bar_lines (f
, value
, oldval
)
2005 Lisp_Object value
, oldval
;
2009 /* Use VALUE only if an integer >= 0. */
2010 if (INTEGERP (value
) && XINT (value
) >= 0)
2011 nlines
= XFASTINT (value
);
2015 /* Make sure we redisplay all windows in this frame. */
2016 ++windows_or_buffers_changed
;
2018 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2019 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2020 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2025 /* Set the foreground color for scroll bars on frame F to VALUE.
2026 VALUE should be a string, a color name. If it isn't a string or
2027 isn't a valid color name, do nothing. OLDVAL is the old value of
2028 the frame parameter. */
2031 x_set_scroll_bar_foreground (f
, value
, oldval
)
2033 Lisp_Object value
, oldval
;
2035 unsigned long pixel
;
2037 if (STRINGP (value
))
2038 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2042 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2043 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2045 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2046 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2048 /* Remove all scroll bars because they have wrong colors. */
2049 if (condemn_scroll_bars_hook
)
2050 (*condemn_scroll_bars_hook
) (f
);
2051 if (judge_scroll_bars_hook
)
2052 (*judge_scroll_bars_hook
) (f
);
2054 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2060 /* Set the background color for scroll bars on frame F to VALUE VALUE
2061 should be a string, a color name. If it isn't a string or isn't a
2062 valid color name, do nothing. OLDVAL is the old value of the frame
2066 x_set_scroll_bar_background (f
, value
, oldval
)
2068 Lisp_Object value
, oldval
;
2070 unsigned long pixel
;
2072 if (STRINGP (value
))
2073 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2077 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2078 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2080 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2081 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2083 /* Remove all scroll bars because they have wrong colors. */
2084 if (condemn_scroll_bars_hook
)
2085 (*condemn_scroll_bars_hook
) (f
);
2086 if (judge_scroll_bars_hook
)
2087 (*judge_scroll_bars_hook
) (f
);
2089 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2095 /* Encode Lisp string STRING as a text in a format appropriate for
2096 XICCC (X Inter Client Communication Conventions).
2098 If STRING contains only ASCII characters, do no conversion and
2099 return the string data of STRING. Otherwise, encode the text by
2100 CODING_SYSTEM, and return a newly allocated memory area which
2101 should be freed by `xfree' by a caller.
2103 Store the byte length of resulting text in *TEXT_BYTES.
2105 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2106 which means that the `encoding' of the result can be `STRING'.
2107 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2108 the result should be `COMPOUND_TEXT'. */
2111 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2112 Lisp_Object string
, coding_system
;
2113 int *text_bytes
, *stringp
;
2115 unsigned char *str
= XSTRING (string
)->data
;
2116 int chars
= XSTRING (string
)->size
;
2117 int bytes
= STRING_BYTES (XSTRING (string
));
2121 struct coding_system coding
;
2123 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2124 if (charset_info
== 0)
2126 /* No multibyte character in OBJ. We need not encode it. */
2127 *text_bytes
= bytes
;
2132 setup_coding_system (coding_system
, &coding
);
2133 coding
.src_multibyte
= 1;
2134 coding
.dst_multibyte
= 0;
2135 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2136 if (coding
.type
== coding_type_iso2022
)
2137 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2138 bufsize
= encoding_buffer_size (&coding
, bytes
);
2139 buf
= (unsigned char *) xmalloc (bufsize
);
2140 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2141 *text_bytes
= coding
.produced
;
2142 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2147 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2150 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2151 name; if NAME is a string, set F's name to NAME and set
2152 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2154 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2155 suggesting a new name, which lisp code should override; if
2156 F->explicit_name is set, ignore the new name; otherwise, set it. */
2159 x_set_name (f
, name
, explicit)
2164 /* Make sure that requests from lisp code override requests from
2165 Emacs redisplay code. */
2168 /* If we're switching from explicit to implicit, we had better
2169 update the mode lines and thereby update the title. */
2170 if (f
->explicit_name
&& NILP (name
))
2171 update_mode_lines
= 1;
2173 f
->explicit_name
= ! NILP (name
);
2175 else if (f
->explicit_name
)
2178 /* If NAME is nil, set the name to the x_id_name. */
2181 /* Check for no change needed in this very common case
2182 before we do any consing. */
2183 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2184 XSTRING (f
->name
)->data
))
2186 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2189 CHECK_STRING (name
, 0);
2191 /* Don't change the name if it's already NAME. */
2192 if (! NILP (Fstring_equal (name
, f
->name
)))
2197 /* For setting the frame title, the title parameter should override
2198 the name parameter. */
2199 if (! NILP (f
->title
))
2202 if (FRAME_X_WINDOW (f
))
2207 XTextProperty text
, icon
;
2209 Lisp_Object coding_system
;
2211 coding_system
= Vlocale_coding_system
;
2212 if (NILP (coding_system
))
2213 coding_system
= Qcompound_text
;
2214 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2215 text
.encoding
= (stringp
? XA_STRING
2216 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2218 text
.nitems
= bytes
;
2220 if (NILP (f
->icon_name
))
2226 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2228 icon
.encoding
= (stringp
? XA_STRING
2229 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2231 icon
.nitems
= bytes
;
2233 #ifdef USE_X_TOOLKIT
2234 XSetWMName (FRAME_X_DISPLAY (f
),
2235 XtWindow (f
->output_data
.x
->widget
), &text
);
2236 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2238 #else /* not USE_X_TOOLKIT */
2239 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2240 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2241 #endif /* not USE_X_TOOLKIT */
2242 if (!NILP (f
->icon_name
)
2243 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2245 if (text
.value
!= XSTRING (name
)->data
)
2248 #else /* not HAVE_X11R4 */
2249 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2250 XSTRING (name
)->data
);
2251 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2252 XSTRING (name
)->data
);
2253 #endif /* not HAVE_X11R4 */
2258 /* This function should be called when the user's lisp code has
2259 specified a name for the frame; the name will override any set by the
2262 x_explicitly_set_name (f
, arg
, oldval
)
2264 Lisp_Object arg
, oldval
;
2266 x_set_name (f
, arg
, 1);
2269 /* This function should be called by Emacs redisplay code to set the
2270 name; names set this way will never override names set by the user's
2273 x_implicitly_set_name (f
, arg
, oldval
)
2275 Lisp_Object arg
, oldval
;
2277 x_set_name (f
, arg
, 0);
2280 /* Change the title of frame F to NAME.
2281 If NAME is nil, use the frame name as the title.
2283 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2284 name; if NAME is a string, set F's name to NAME and set
2285 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2287 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2288 suggesting a new name, which lisp code should override; if
2289 F->explicit_name is set, ignore the new name; otherwise, set it. */
2292 x_set_title (f
, name
, old_name
)
2294 Lisp_Object name
, old_name
;
2296 /* Don't change the title if it's already NAME. */
2297 if (EQ (name
, f
->title
))
2300 update_mode_lines
= 1;
2307 CHECK_STRING (name
, 0);
2309 if (FRAME_X_WINDOW (f
))
2314 XTextProperty text
, icon
;
2316 Lisp_Object coding_system
;
2318 coding_system
= Vlocale_coding_system
;
2319 if (NILP (coding_system
))
2320 coding_system
= Qcompound_text
;
2321 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2322 text
.encoding
= (stringp
? XA_STRING
2323 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2325 text
.nitems
= bytes
;
2327 if (NILP (f
->icon_name
))
2333 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2335 icon
.encoding
= (stringp
? XA_STRING
2336 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2338 icon
.nitems
= bytes
;
2340 #ifdef USE_X_TOOLKIT
2341 XSetWMName (FRAME_X_DISPLAY (f
),
2342 XtWindow (f
->output_data
.x
->widget
), &text
);
2343 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2345 #else /* not USE_X_TOOLKIT */
2346 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2347 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2348 #endif /* not USE_X_TOOLKIT */
2349 if (!NILP (f
->icon_name
)
2350 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2352 if (text
.value
!= XSTRING (name
)->data
)
2355 #else /* not HAVE_X11R4 */
2356 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2357 XSTRING (name
)->data
);
2358 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2359 XSTRING (name
)->data
);
2360 #endif /* not HAVE_X11R4 */
2366 x_set_autoraise (f
, arg
, oldval
)
2368 Lisp_Object arg
, oldval
;
2370 f
->auto_raise
= !EQ (Qnil
, arg
);
2374 x_set_autolower (f
, arg
, oldval
)
2376 Lisp_Object arg
, oldval
;
2378 f
->auto_lower
= !EQ (Qnil
, arg
);
2382 x_set_unsplittable (f
, arg
, oldval
)
2384 Lisp_Object arg
, oldval
;
2386 f
->no_split
= !NILP (arg
);
2390 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2392 Lisp_Object arg
, oldval
;
2394 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2395 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2396 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2397 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2399 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2401 ? vertical_scroll_bar_none
2403 ? vertical_scroll_bar_right
2404 : vertical_scroll_bar_left
);
2406 /* We set this parameter before creating the X window for the
2407 frame, so we can get the geometry right from the start.
2408 However, if the window hasn't been created yet, we shouldn't
2409 call x_set_window_size. */
2410 if (FRAME_X_WINDOW (f
))
2411 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2412 do_pending_window_change (0);
2417 x_set_scroll_bar_width (f
, arg
, oldval
)
2419 Lisp_Object arg
, oldval
;
2421 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2425 #ifdef USE_TOOLKIT_SCROLL_BARS
2426 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2427 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2428 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2429 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2431 /* Make the actual width at least 14 pixels and a multiple of a
2433 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2435 /* Use all of that space (aside from required margins) for the
2437 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2440 if (FRAME_X_WINDOW (f
))
2441 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2442 do_pending_window_change (0);
2444 else if (INTEGERP (arg
) && XINT (arg
) > 0
2445 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2447 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2448 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2450 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2451 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2452 if (FRAME_X_WINDOW (f
))
2453 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2456 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2457 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2458 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2463 /* Subroutines of creating an X frame. */
2465 /* Make sure that Vx_resource_name is set to a reasonable value.
2466 Fix it up, or set it to `emacs' if it is too hopeless. */
2469 validate_x_resource_name ()
2472 /* Number of valid characters in the resource name. */
2474 /* Number of invalid characters in the resource name. */
2479 if (!STRINGP (Vx_resource_class
))
2480 Vx_resource_class
= build_string (EMACS_CLASS
);
2482 if (STRINGP (Vx_resource_name
))
2484 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2487 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2489 /* Only letters, digits, - and _ are valid in resource names.
2490 Count the valid characters and count the invalid ones. */
2491 for (i
= 0; i
< len
; i
++)
2494 if (! ((c
>= 'a' && c
<= 'z')
2495 || (c
>= 'A' && c
<= 'Z')
2496 || (c
>= '0' && c
<= '9')
2497 || c
== '-' || c
== '_'))
2504 /* Not a string => completely invalid. */
2505 bad_count
= 5, good_count
= 0;
2507 /* If name is valid already, return. */
2511 /* If name is entirely invalid, or nearly so, use `emacs'. */
2513 || (good_count
== 1 && bad_count
> 0))
2515 Vx_resource_name
= build_string ("emacs");
2519 /* Name is partly valid. Copy it and replace the invalid characters
2520 with underscores. */
2522 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2524 for (i
= 0; i
< len
; i
++)
2526 int c
= XSTRING (new)->data
[i
];
2527 if (! ((c
>= 'a' && c
<= 'z')
2528 || (c
>= 'A' && c
<= 'Z')
2529 || (c
>= '0' && c
<= '9')
2530 || c
== '-' || c
== '_'))
2531 XSTRING (new)->data
[i
] = '_';
2536 extern char *x_get_string_resource ();
2538 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2539 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2540 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2541 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2542 the name specified by the `-name' or `-rn' command-line arguments.\n\
2544 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2545 class, respectively. You must specify both of them or neither.\n\
2546 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2547 and the class is `Emacs.CLASS.SUBCLASS'.")
2548 (attribute
, class, component
, subclass
)
2549 Lisp_Object attribute
, class, component
, subclass
;
2551 register char *value
;
2557 CHECK_STRING (attribute
, 0);
2558 CHECK_STRING (class, 0);
2560 if (!NILP (component
))
2561 CHECK_STRING (component
, 1);
2562 if (!NILP (subclass
))
2563 CHECK_STRING (subclass
, 2);
2564 if (NILP (component
) != NILP (subclass
))
2565 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2567 validate_x_resource_name ();
2569 /* Allocate space for the components, the dots which separate them,
2570 and the final '\0'. Make them big enough for the worst case. */
2571 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2572 + (STRINGP (component
)
2573 ? STRING_BYTES (XSTRING (component
)) : 0)
2574 + STRING_BYTES (XSTRING (attribute
))
2577 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2578 + STRING_BYTES (XSTRING (class))
2579 + (STRINGP (subclass
)
2580 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2583 /* Start with emacs.FRAMENAME for the name (the specific one)
2584 and with `Emacs' for the class key (the general one). */
2585 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2586 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2588 strcat (class_key
, ".");
2589 strcat (class_key
, XSTRING (class)->data
);
2591 if (!NILP (component
))
2593 strcat (class_key
, ".");
2594 strcat (class_key
, XSTRING (subclass
)->data
);
2596 strcat (name_key
, ".");
2597 strcat (name_key
, XSTRING (component
)->data
);
2600 strcat (name_key
, ".");
2601 strcat (name_key
, XSTRING (attribute
)->data
);
2603 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2604 name_key
, class_key
);
2606 if (value
!= (char *) 0)
2607 return build_string (value
);
2612 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2615 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2616 struct x_display_info
*dpyinfo
;
2617 Lisp_Object attribute
, class, component
, subclass
;
2619 register char *value
;
2623 CHECK_STRING (attribute
, 0);
2624 CHECK_STRING (class, 0);
2626 if (!NILP (component
))
2627 CHECK_STRING (component
, 1);
2628 if (!NILP (subclass
))
2629 CHECK_STRING (subclass
, 2);
2630 if (NILP (component
) != NILP (subclass
))
2631 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2633 validate_x_resource_name ();
2635 /* Allocate space for the components, the dots which separate them,
2636 and the final '\0'. Make them big enough for the worst case. */
2637 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2638 + (STRINGP (component
)
2639 ? STRING_BYTES (XSTRING (component
)) : 0)
2640 + STRING_BYTES (XSTRING (attribute
))
2643 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2644 + STRING_BYTES (XSTRING (class))
2645 + (STRINGP (subclass
)
2646 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2649 /* Start with emacs.FRAMENAME for the name (the specific one)
2650 and with `Emacs' for the class key (the general one). */
2651 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2652 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2654 strcat (class_key
, ".");
2655 strcat (class_key
, XSTRING (class)->data
);
2657 if (!NILP (component
))
2659 strcat (class_key
, ".");
2660 strcat (class_key
, XSTRING (subclass
)->data
);
2662 strcat (name_key
, ".");
2663 strcat (name_key
, XSTRING (component
)->data
);
2666 strcat (name_key
, ".");
2667 strcat (name_key
, XSTRING (attribute
)->data
);
2669 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2671 if (value
!= (char *) 0)
2672 return build_string (value
);
2677 /* Used when C code wants a resource value. */
2680 x_get_resource_string (attribute
, class)
2681 char *attribute
, *class;
2685 struct frame
*sf
= SELECTED_FRAME ();
2687 /* Allocate space for the components, the dots which separate them,
2688 and the final '\0'. */
2689 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2690 + strlen (attribute
) + 2);
2691 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2692 + strlen (class) + 2);
2694 sprintf (name_key
, "%s.%s",
2695 XSTRING (Vinvocation_name
)->data
,
2697 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2699 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2700 name_key
, class_key
);
2703 /* Types we might convert a resource string into. */
2713 /* Return the value of parameter PARAM.
2715 First search ALIST, then Vdefault_frame_alist, then the X defaults
2716 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2718 Convert the resource to the type specified by desired_type.
2720 If no default is specified, return Qunbound. If you call
2721 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2722 and don't let it get stored in any Lisp-visible variables! */
2725 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2726 struct x_display_info
*dpyinfo
;
2727 Lisp_Object alist
, param
;
2730 enum resource_types type
;
2732 register Lisp_Object tem
;
2734 tem
= Fassq (param
, alist
);
2736 tem
= Fassq (param
, Vdefault_frame_alist
);
2742 tem
= display_x_get_resource (dpyinfo
,
2743 build_string (attribute
),
2744 build_string (class),
2752 case RES_TYPE_NUMBER
:
2753 return make_number (atoi (XSTRING (tem
)->data
));
2755 case RES_TYPE_FLOAT
:
2756 return make_float (atof (XSTRING (tem
)->data
));
2758 case RES_TYPE_BOOLEAN
:
2759 tem
= Fdowncase (tem
);
2760 if (!strcmp (XSTRING (tem
)->data
, "on")
2761 || !strcmp (XSTRING (tem
)->data
, "true"))
2766 case RES_TYPE_STRING
:
2769 case RES_TYPE_SYMBOL
:
2770 /* As a special case, we map the values `true' and `on'
2771 to Qt, and `false' and `off' to Qnil. */
2774 lower
= Fdowncase (tem
);
2775 if (!strcmp (XSTRING (lower
)->data
, "on")
2776 || !strcmp (XSTRING (lower
)->data
, "true"))
2778 else if (!strcmp (XSTRING (lower
)->data
, "off")
2779 || !strcmp (XSTRING (lower
)->data
, "false"))
2782 return Fintern (tem
, Qnil
);
2795 /* Like x_get_arg, but also record the value in f->param_alist. */
2798 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2800 Lisp_Object alist
, param
;
2803 enum resource_types type
;
2807 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2808 attribute
, class, type
);
2810 store_frame_param (f
, param
, value
);
2815 /* Record in frame F the specified or default value according to ALIST
2816 of the parameter named PROP (a Lisp symbol).
2817 If no value is specified for PROP, look for an X default for XPROP
2818 on the frame named NAME.
2819 If that is not found either, use the value DEFLT. */
2822 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2829 enum resource_types type
;
2833 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2834 if (EQ (tem
, Qunbound
))
2836 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2841 /* Record in frame F the specified or default value according to ALIST
2842 of the parameter named PROP (a Lisp symbol). If no value is
2843 specified for PROP, look for an X default for XPROP on the frame
2844 named NAME. If that is not found either, use the value DEFLT. */
2847 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2856 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2859 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2860 if (EQ (tem
, Qunbound
))
2862 #ifdef USE_TOOLKIT_SCROLL_BARS
2864 /* See if an X resource for the scroll bar color has been
2866 tem
= display_x_get_resource (dpyinfo
,
2867 build_string (foreground_p
2871 build_string ("verticalScrollBar"),
2875 /* If nothing has been specified, scroll bars will use a
2876 toolkit-dependent default. Because these defaults are
2877 difficult to get at without actually creating a scroll
2878 bar, use nil to indicate that no color has been
2883 #else /* not USE_TOOLKIT_SCROLL_BARS */
2887 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2890 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2896 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2897 "Parse an X-style geometry string STRING.\n\
2898 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2899 The properties returned may include `top', `left', `height', and `width'.\n\
2900 The value of `left' or `top' may be an integer,\n\
2901 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2902 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2907 unsigned int width
, height
;
2910 CHECK_STRING (string
, 0);
2912 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2913 &x
, &y
, &width
, &height
);
2916 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2917 error ("Must specify both x and y position, or neither");
2921 if (geometry
& XValue
)
2923 Lisp_Object element
;
2925 if (x
>= 0 && (geometry
& XNegative
))
2926 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2927 else if (x
< 0 && ! (geometry
& XNegative
))
2928 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2930 element
= Fcons (Qleft
, make_number (x
));
2931 result
= Fcons (element
, result
);
2934 if (geometry
& YValue
)
2936 Lisp_Object element
;
2938 if (y
>= 0 && (geometry
& YNegative
))
2939 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2940 else if (y
< 0 && ! (geometry
& YNegative
))
2941 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2943 element
= Fcons (Qtop
, make_number (y
));
2944 result
= Fcons (element
, result
);
2947 if (geometry
& WidthValue
)
2948 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2949 if (geometry
& HeightValue
)
2950 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2955 /* Calculate the desired size and position of this window,
2956 and return the flags saying which aspects were specified.
2958 This function does not make the coordinates positive. */
2960 #define DEFAULT_ROWS 40
2961 #define DEFAULT_COLS 80
2964 x_figure_window_size (f
, parms
)
2968 register Lisp_Object tem0
, tem1
, tem2
;
2969 long window_prompting
= 0;
2970 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2972 /* Default values if we fall through.
2973 Actually, if that happens we should get
2974 window manager prompting. */
2975 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2976 f
->height
= DEFAULT_ROWS
;
2977 /* Window managers expect that if program-specified
2978 positions are not (0,0), they're intentional, not defaults. */
2979 f
->output_data
.x
->top_pos
= 0;
2980 f
->output_data
.x
->left_pos
= 0;
2982 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2983 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2984 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2985 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2987 if (!EQ (tem0
, Qunbound
))
2989 CHECK_NUMBER (tem0
, 0);
2990 f
->height
= XINT (tem0
);
2992 if (!EQ (tem1
, Qunbound
))
2994 CHECK_NUMBER (tem1
, 0);
2995 SET_FRAME_WIDTH (f
, XINT (tem1
));
2997 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2998 window_prompting
|= USSize
;
3000 window_prompting
|= PSize
;
3003 f
->output_data
.x
->vertical_scroll_bar_extra
3004 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3006 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3007 f
->output_data
.x
->flags_areas_extra
3008 = FRAME_FLAGS_AREA_WIDTH (f
);
3009 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3010 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3012 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3013 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3014 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3015 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3017 if (EQ (tem0
, Qminus
))
3019 f
->output_data
.x
->top_pos
= 0;
3020 window_prompting
|= YNegative
;
3022 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3023 && CONSP (XCDR (tem0
))
3024 && INTEGERP (XCAR (XCDR (tem0
))))
3026 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3027 window_prompting
|= YNegative
;
3029 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3030 && CONSP (XCDR (tem0
))
3031 && INTEGERP (XCAR (XCDR (tem0
))))
3033 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3035 else if (EQ (tem0
, Qunbound
))
3036 f
->output_data
.x
->top_pos
= 0;
3039 CHECK_NUMBER (tem0
, 0);
3040 f
->output_data
.x
->top_pos
= XINT (tem0
);
3041 if (f
->output_data
.x
->top_pos
< 0)
3042 window_prompting
|= YNegative
;
3045 if (EQ (tem1
, Qminus
))
3047 f
->output_data
.x
->left_pos
= 0;
3048 window_prompting
|= XNegative
;
3050 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3051 && CONSP (XCDR (tem1
))
3052 && INTEGERP (XCAR (XCDR (tem1
))))
3054 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3055 window_prompting
|= XNegative
;
3057 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3058 && CONSP (XCDR (tem1
))
3059 && INTEGERP (XCAR (XCDR (tem1
))))
3061 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3063 else if (EQ (tem1
, Qunbound
))
3064 f
->output_data
.x
->left_pos
= 0;
3067 CHECK_NUMBER (tem1
, 0);
3068 f
->output_data
.x
->left_pos
= XINT (tem1
);
3069 if (f
->output_data
.x
->left_pos
< 0)
3070 window_prompting
|= XNegative
;
3073 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3074 window_prompting
|= USPosition
;
3076 window_prompting
|= PPosition
;
3079 return window_prompting
;
3082 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3085 XSetWMProtocols (dpy
, w
, protocols
, count
)
3092 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3093 if (prop
== None
) return False
;
3094 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3095 (unsigned char *) protocols
, count
);
3098 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3100 #ifdef USE_X_TOOLKIT
3102 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3103 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3104 already be present because of the toolkit (Motif adds some of them,
3105 for example, but Xt doesn't). */
3108 hack_wm_protocols (f
, widget
)
3112 Display
*dpy
= XtDisplay (widget
);
3113 Window w
= XtWindow (widget
);
3114 int need_delete
= 1;
3120 Atom type
, *atoms
= 0;
3122 unsigned long nitems
= 0;
3123 unsigned long bytes_after
;
3125 if ((XGetWindowProperty (dpy
, w
,
3126 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3127 (long)0, (long)100, False
, XA_ATOM
,
3128 &type
, &format
, &nitems
, &bytes_after
,
3129 (unsigned char **) &atoms
)
3131 && format
== 32 && type
== XA_ATOM
)
3135 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3137 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3139 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3142 if (atoms
) XFree ((char *) atoms
);
3148 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3150 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3152 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3154 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3155 XA_ATOM
, 32, PropModeAppend
,
3156 (unsigned char *) props
, count
);
3164 /* Support routines for XIC (X Input Context). */
3168 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3169 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3172 /* Supported XIM styles, ordered by preferenc. */
3174 static XIMStyle supported_xim_styles
[] =
3176 XIMPreeditPosition
| XIMStatusArea
,
3177 XIMPreeditPosition
| XIMStatusNothing
,
3178 XIMPreeditPosition
| XIMStatusNone
,
3179 XIMPreeditNothing
| XIMStatusArea
,
3180 XIMPreeditNothing
| XIMStatusNothing
,
3181 XIMPreeditNothing
| XIMStatusNone
,
3182 XIMPreeditNone
| XIMStatusArea
,
3183 XIMPreeditNone
| XIMStatusNothing
,
3184 XIMPreeditNone
| XIMStatusNone
,
3189 /* Create an X fontset on frame F with base font name
3193 xic_create_xfontset (f
, base_fontname
)
3195 char *base_fontname
;
3198 char **missing_list
;
3202 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3203 base_fontname
, &missing_list
,
3204 &missing_count
, &def_string
);
3206 XFreeStringList (missing_list
);
3208 /* No need to free def_string. */
3213 /* Value is the best input style, given user preferences USER (already
3214 checked to be supported by Emacs), and styles supported by the
3215 input method XIM. */
3218 best_xim_style (user
, xim
)
3224 for (i
= 0; i
< user
->count_styles
; ++i
)
3225 for (j
= 0; j
< xim
->count_styles
; ++j
)
3226 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3227 return user
->supported_styles
[i
];
3229 /* Return the default style. */
3230 return XIMPreeditNothing
| XIMStatusNothing
;
3233 /* Create XIC for frame F. */
3236 create_frame_xic (f
)
3241 XFontSet xfs
= NULL
;
3242 static XIMStyle xic_style
;
3247 xim
= FRAME_X_XIM (f
);
3252 XVaNestedList preedit_attr
;
3253 XVaNestedList status_attr
;
3254 char *base_fontname
;
3257 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3258 spot
.x
= 0; spot
.y
= 1;
3259 /* Create X fontset. */
3260 fontset
= FRAME_FONTSET (f
);
3262 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3265 /* Determine the base fontname from the ASCII font name of
3267 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3268 char *p
= ascii_font
;
3271 for (i
= 0; *p
; p
++)
3274 /* As the font name doesn't conform to XLFD, we can't
3275 modify it to get a suitable base fontname for the
3277 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3280 int len
= strlen (ascii_font
) + 1;
3283 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3292 base_fontname
= (char *) alloca (len
);
3293 bzero (base_fontname
, len
);
3294 strcpy (base_fontname
, "-*-*-");
3295 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3296 strcat (base_fontname
, "*-*-*-*-*-*-*");
3299 xfs
= xic_create_xfontset (f
, base_fontname
);
3301 /* Determine XIC style. */
3304 XIMStyles supported_list
;
3305 supported_list
.count_styles
= (sizeof supported_xim_styles
3306 / sizeof supported_xim_styles
[0]);
3307 supported_list
.supported_styles
= supported_xim_styles
;
3308 xic_style
= best_xim_style (&supported_list
,
3309 FRAME_X_XIM_STYLES (f
));
3312 preedit_attr
= XVaCreateNestedList (0,
3315 FRAME_FOREGROUND_PIXEL (f
),
3317 FRAME_BACKGROUND_PIXEL (f
),
3318 (xic_style
& XIMPreeditPosition
3323 status_attr
= XVaCreateNestedList (0,
3329 FRAME_FOREGROUND_PIXEL (f
),
3331 FRAME_BACKGROUND_PIXEL (f
),
3334 xic
= XCreateIC (xim
,
3335 XNInputStyle
, xic_style
,
3336 XNClientWindow
, FRAME_X_WINDOW(f
),
3337 XNFocusWindow
, FRAME_X_WINDOW(f
),
3338 XNStatusAttributes
, status_attr
,
3339 XNPreeditAttributes
, preedit_attr
,
3341 XFree (preedit_attr
);
3342 XFree (status_attr
);
3345 FRAME_XIC (f
) = xic
;
3346 FRAME_XIC_STYLE (f
) = xic_style
;
3347 FRAME_XIC_FONTSET (f
) = xfs
;
3351 /* Destroy XIC and free XIC fontset of frame F, if any. */
3357 if (FRAME_XIC (f
) == NULL
)
3360 XDestroyIC (FRAME_XIC (f
));
3361 if (FRAME_XIC_FONTSET (f
))
3362 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3364 FRAME_XIC (f
) = NULL
;
3365 FRAME_XIC_FONTSET (f
) = NULL
;
3369 /* Place preedit area for XIC of window W's frame to specified
3370 pixel position X/Y. X and Y are relative to window W. */
3373 xic_set_preeditarea (w
, x
, y
)
3377 struct frame
*f
= XFRAME (w
->frame
);
3381 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3382 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3383 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3384 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3389 /* Place status area for XIC in bottom right corner of frame F.. */
3392 xic_set_statusarea (f
)
3395 XIC xic
= FRAME_XIC (f
);
3400 /* Negotiate geometry of status area. If input method has existing
3401 status area, use its current size. */
3402 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3403 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3404 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3407 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3408 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3411 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3413 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3414 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3418 area
.width
= needed
->width
;
3419 area
.height
= needed
->height
;
3420 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3421 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3422 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3425 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3426 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3431 /* Set X fontset for XIC of frame F, using base font name
3432 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3435 xic_set_xfontset (f
, base_fontname
)
3437 char *base_fontname
;
3442 xfs
= xic_create_xfontset (f
, base_fontname
);
3444 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3445 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3446 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3447 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3448 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3451 if (FRAME_XIC_FONTSET (f
))
3452 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3453 FRAME_XIC_FONTSET (f
) = xfs
;
3456 #endif /* HAVE_X_I18N */
3460 #ifdef USE_X_TOOLKIT
3462 /* Create and set up the X widget for frame F. */
3465 x_window (f
, window_prompting
, minibuffer_only
)
3467 long window_prompting
;
3468 int minibuffer_only
;
3470 XClassHint class_hints
;
3471 XSetWindowAttributes attributes
;
3472 unsigned long attribute_mask
;
3473 Widget shell_widget
;
3475 Widget frame_widget
;
3481 /* Use the resource name as the top-level widget name
3482 for looking up resources. Make a non-Lisp copy
3483 for the window manager, so GC relocation won't bother it.
3485 Elsewhere we specify the window name for the window manager. */
3488 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3489 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3490 strcpy (f
->namebuf
, str
);
3494 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3495 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3496 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3497 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3498 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3499 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3500 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3501 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3502 applicationShellWidgetClass
,
3503 FRAME_X_DISPLAY (f
), al
, ac
);
3505 f
->output_data
.x
->widget
= shell_widget
;
3506 /* maybe_set_screen_title_format (shell_widget); */
3508 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3509 (widget_value
*) NULL
,
3510 shell_widget
, False
,
3514 (lw_callback
) NULL
);
3517 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3518 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3519 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3520 XtSetValues (pane_widget
, al
, ac
);
3521 f
->output_data
.x
->column_widget
= pane_widget
;
3523 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3524 the emacs screen when changing menubar. This reduces flickering. */
3527 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3528 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3529 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3530 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3531 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3532 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3533 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3534 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3535 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3538 f
->output_data
.x
->edit_widget
= frame_widget
;
3540 XtManageChild (frame_widget
);
3542 /* Do some needed geometry management. */
3545 char *tem
, shell_position
[32];
3548 int extra_borders
= 0;
3550 = (f
->output_data
.x
->menubar_widget
3551 ? (f
->output_data
.x
->menubar_widget
->core
.height
3552 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3555 #if 0 /* Experimentally, we now get the right results
3556 for -geometry -0-0 without this. 24 Aug 96, rms. */
3557 if (FRAME_EXTERNAL_MENU_BAR (f
))
3560 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3561 menubar_size
+= ibw
;
3565 f
->output_data
.x
->menubar_height
= menubar_size
;
3568 /* Motif seems to need this amount added to the sizes
3569 specified for the shell widget. The Athena/Lucid widgets don't.
3570 Both conclusions reached experimentally. -- rms. */
3571 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3572 &extra_borders
, NULL
);
3576 /* Convert our geometry parameters into a geometry string
3578 Note that we do not specify here whether the position
3579 is a user-specified or program-specified one.
3580 We pass that information later, in x_wm_set_size_hints. */
3582 int left
= f
->output_data
.x
->left_pos
;
3583 int xneg
= window_prompting
& XNegative
;
3584 int top
= f
->output_data
.x
->top_pos
;
3585 int yneg
= window_prompting
& YNegative
;
3591 if (window_prompting
& USPosition
)
3592 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3593 PIXEL_WIDTH (f
) + extra_borders
,
3594 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3595 (xneg
? '-' : '+'), left
,
3596 (yneg
? '-' : '+'), top
);
3598 sprintf (shell_position
, "=%dx%d",
3599 PIXEL_WIDTH (f
) + extra_borders
,
3600 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3603 len
= strlen (shell_position
) + 1;
3604 /* We don't free this because we don't know whether
3605 it is safe to free it while the frame exists.
3606 It isn't worth the trouble of arranging to free it
3607 when the frame is deleted. */
3608 tem
= (char *) xmalloc (len
);
3609 strncpy (tem
, shell_position
, len
);
3610 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3611 XtSetValues (shell_widget
, al
, ac
);
3614 XtManageChild (pane_widget
);
3615 XtRealizeWidget (shell_widget
);
3617 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3619 validate_x_resource_name ();
3621 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3622 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3623 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3626 FRAME_XIC (f
) = NULL
;
3628 create_frame_xic (f
);
3632 f
->output_data
.x
->wm_hints
.input
= True
;
3633 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3634 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3635 &f
->output_data
.x
->wm_hints
);
3637 hack_wm_protocols (f
, shell_widget
);
3640 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3643 /* Do a stupid property change to force the server to generate a
3644 PropertyNotify event so that the event_stream server timestamp will
3645 be initialized to something relevant to the time we created the window.
3647 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3648 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3649 XA_ATOM
, 32, PropModeAppend
,
3650 (unsigned char*) NULL
, 0);
3652 /* Make all the standard events reach the Emacs frame. */
3653 attributes
.event_mask
= STANDARD_EVENT_SET
;
3658 /* XIM server might require some X events. */
3659 unsigned long fevent
= NoEventMask
;
3660 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3661 attributes
.event_mask
|= fevent
;
3663 #endif /* HAVE_X_I18N */
3665 attribute_mask
= CWEventMask
;
3666 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3667 attribute_mask
, &attributes
);
3669 XtMapWidget (frame_widget
);
3671 /* x_set_name normally ignores requests to set the name if the
3672 requested name is the same as the current name. This is the one
3673 place where that assumption isn't correct; f->name is set, but
3674 the X server hasn't been told. */
3677 int explicit = f
->explicit_name
;
3679 f
->explicit_name
= 0;
3682 x_set_name (f
, name
, explicit);
3685 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3686 f
->output_data
.x
->text_cursor
);
3690 /* This is a no-op, except under Motif. Make sure main areas are
3691 set to something reasonable, in case we get an error later. */
3692 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3695 #else /* not USE_X_TOOLKIT */
3697 /* Create and set up the X window for frame F. */
3704 XClassHint class_hints
;
3705 XSetWindowAttributes attributes
;
3706 unsigned long attribute_mask
;
3708 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3709 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3710 attributes
.bit_gravity
= StaticGravity
;
3711 attributes
.backing_store
= NotUseful
;
3712 attributes
.save_under
= True
;
3713 attributes
.event_mask
= STANDARD_EVENT_SET
;
3714 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3715 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3720 = XCreateWindow (FRAME_X_DISPLAY (f
),
3721 f
->output_data
.x
->parent_desc
,
3722 f
->output_data
.x
->left_pos
,
3723 f
->output_data
.x
->top_pos
,
3724 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3725 f
->output_data
.x
->border_width
,
3726 CopyFromParent
, /* depth */
3727 InputOutput
, /* class */
3729 attribute_mask
, &attributes
);
3733 create_frame_xic (f
);
3736 /* XIM server might require some X events. */
3737 unsigned long fevent
= NoEventMask
;
3738 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3739 attributes
.event_mask
|= fevent
;
3740 attribute_mask
= CWEventMask
;
3741 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3742 attribute_mask
, &attributes
);
3745 #endif /* HAVE_X_I18N */
3747 validate_x_resource_name ();
3749 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3750 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3751 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3753 /* The menubar is part of the ordinary display;
3754 it does not count in addition to the height of the window. */
3755 f
->output_data
.x
->menubar_height
= 0;
3757 /* This indicates that we use the "Passive Input" input model.
3758 Unless we do this, we don't get the Focus{In,Out} events that we
3759 need to draw the cursor correctly. Accursed bureaucrats.
3760 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3762 f
->output_data
.x
->wm_hints
.input
= True
;
3763 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3764 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3765 &f
->output_data
.x
->wm_hints
);
3766 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3768 /* Request "save yourself" and "delete window" commands from wm. */
3771 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3772 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3773 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3776 /* x_set_name normally ignores requests to set the name if the
3777 requested name is the same as the current name. This is the one
3778 place where that assumption isn't correct; f->name is set, but
3779 the X server hasn't been told. */
3782 int explicit = f
->explicit_name
;
3784 f
->explicit_name
= 0;
3787 x_set_name (f
, name
, explicit);
3790 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3791 f
->output_data
.x
->text_cursor
);
3795 if (FRAME_X_WINDOW (f
) == 0)
3796 error ("Unable to create window");
3799 #endif /* not USE_X_TOOLKIT */
3801 /* Handle the icon stuff for this window. Perhaps later we might
3802 want an x_set_icon_position which can be called interactively as
3810 Lisp_Object icon_x
, icon_y
;
3811 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3813 /* Set the position of the icon. Note that twm groups all
3814 icons in an icon window. */
3815 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3816 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3817 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3819 CHECK_NUMBER (icon_x
, 0);
3820 CHECK_NUMBER (icon_y
, 0);
3822 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3823 error ("Both left and top icon corners of icon must be specified");
3827 if (! EQ (icon_x
, Qunbound
))
3828 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3830 /* Start up iconic or window? */
3831 x_wm_set_window_state
3832 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3837 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3844 /* Make the GCs needed for this window, setting the
3845 background, border and mouse colors; also create the
3846 mouse cursor and the gray border tile. */
3848 static char cursor_bits
[] =
3850 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3851 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3852 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3853 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3860 XGCValues gc_values
;
3864 /* Create the GCs of this frame.
3865 Note that many default values are used. */
3868 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3869 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3870 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3871 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3872 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3874 GCLineWidth
| GCFont
3875 | GCForeground
| GCBackground
,
3878 /* Reverse video style. */
3879 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3880 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3881 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3883 GCFont
| GCForeground
| GCBackground
3887 /* Cursor has cursor-color background, background-color foreground. */
3888 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3889 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3890 gc_values
.fill_style
= FillOpaqueStippled
;
3892 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3893 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3894 cursor_bits
, 16, 16);
3895 f
->output_data
.x
->cursor_gc
3896 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3897 (GCFont
| GCForeground
| GCBackground
3898 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3902 f
->output_data
.x
->white_relief
.gc
= 0;
3903 f
->output_data
.x
->black_relief
.gc
= 0;
3905 /* Create the gray border tile used when the pointer is not in
3906 the frame. Since this depends on the frame's pixel values,
3907 this must be done on a per-frame basis. */
3908 f
->output_data
.x
->border_tile
3909 = (XCreatePixmapFromBitmapData
3910 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3911 gray_bits
, gray_width
, gray_height
,
3912 f
->output_data
.x
->foreground_pixel
,
3913 f
->output_data
.x
->background_pixel
,
3914 DefaultDepth (FRAME_X_DISPLAY (f
),
3915 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3920 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3922 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3923 Returns an Emacs frame object.\n\
3924 ALIST is an alist of frame parameters.\n\
3925 If the parameters specify that the frame should not have a minibuffer,\n\
3926 and do not specify a specific minibuffer window to use,\n\
3927 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3928 be shared by the new frame.\n\
3930 This function is an internal primitive--use `make-frame' instead.")
3935 Lisp_Object frame
, tem
;
3937 int minibuffer_only
= 0;
3938 long window_prompting
= 0;
3940 int count
= specpdl_ptr
- specpdl
;
3941 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3942 Lisp_Object display
;
3943 struct x_display_info
*dpyinfo
= NULL
;
3949 /* Use this general default value to start with
3950 until we know if this frame has a specified name. */
3951 Vx_resource_name
= Vinvocation_name
;
3953 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3954 if (EQ (display
, Qunbound
))
3956 dpyinfo
= check_x_display_info (display
);
3958 kb
= dpyinfo
->kboard
;
3960 kb
= &the_only_kboard
;
3963 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3965 && ! EQ (name
, Qunbound
)
3967 error ("Invalid frame name--not a string or nil");
3970 Vx_resource_name
= name
;
3972 /* See if parent window is specified. */
3973 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3974 if (EQ (parent
, Qunbound
))
3976 if (! NILP (parent
))
3977 CHECK_NUMBER (parent
, 0);
3979 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3980 /* No need to protect DISPLAY because that's not used after passing
3981 it to make_frame_without_minibuffer. */
3983 GCPRO4 (parms
, parent
, name
, frame
);
3984 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3986 if (EQ (tem
, Qnone
) || NILP (tem
))
3987 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3988 else if (EQ (tem
, Qonly
))
3990 f
= make_minibuffer_frame ();
3991 minibuffer_only
= 1;
3993 else if (WINDOWP (tem
))
3994 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3998 XSETFRAME (frame
, f
);
4000 /* Note that X Windows does support scroll bars. */
4001 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4003 f
->output_method
= output_x_window
;
4004 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4005 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4006 f
->output_data
.x
->icon_bitmap
= -1;
4007 f
->output_data
.x
->fontset
= -1;
4008 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4009 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4012 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4014 if (! STRINGP (f
->icon_name
))
4015 f
->icon_name
= Qnil
;
4017 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4019 FRAME_KBOARD (f
) = kb
;
4022 /* These colors will be set anyway later, but it's important
4023 to get the color reference counts right, so initialize them! */
4026 struct gcpro gcpro1
;
4028 black
= build_string ("black");
4030 f
->output_data
.x
->foreground_pixel
4031 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4032 f
->output_data
.x
->background_pixel
4033 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4034 f
->output_data
.x
->cursor_pixel
4035 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4036 f
->output_data
.x
->cursor_foreground_pixel
4037 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4038 f
->output_data
.x
->border_pixel
4039 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4040 f
->output_data
.x
->mouse_pixel
4041 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4045 /* Specify the parent under which to make this X window. */
4049 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4050 f
->output_data
.x
->explicit_parent
= 1;
4054 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4055 f
->output_data
.x
->explicit_parent
= 0;
4058 /* Set the name; the functions to which we pass f expect the name to
4060 if (EQ (name
, Qunbound
) || NILP (name
))
4062 f
->name
= build_string (dpyinfo
->x_id_name
);
4063 f
->explicit_name
= 0;
4068 f
->explicit_name
= 1;
4069 /* use the frame's title when getting resources for this frame. */
4070 specbind (Qx_resource_name
, name
);
4073 /* Extract the window parameters from the supplied values
4074 that are needed to determine window geometry. */
4078 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4081 /* First, try whatever font the caller has specified. */
4084 tem
= Fquery_fontset (font
, Qnil
);
4086 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4088 font
= x_new_font (f
, XSTRING (font
)->data
);
4091 /* Try out a font which we hope has bold and italic variations. */
4092 if (!STRINGP (font
))
4093 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4094 if (!STRINGP (font
))
4095 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4096 if (! STRINGP (font
))
4097 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4098 if (! STRINGP (font
))
4099 /* This was formerly the first thing tried, but it finds too many fonts
4100 and takes too long. */
4101 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4102 /* If those didn't work, look for something which will at least work. */
4103 if (! STRINGP (font
))
4104 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4106 if (! STRINGP (font
))
4107 font
= build_string ("fixed");
4109 x_default_parameter (f
, parms
, Qfont
, font
,
4110 "font", "Font", RES_TYPE_STRING
);
4114 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4115 whereby it fails to get any font. */
4116 xlwmenu_default_font
= f
->output_data
.x
->font
;
4119 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4120 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4122 /* This defaults to 2 in order to match xterm. We recognize either
4123 internalBorderWidth or internalBorder (which is what xterm calls
4125 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4129 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4130 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4131 if (! EQ (value
, Qunbound
))
4132 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4135 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4136 "internalBorderWidth", "internalBorderWidth",
4138 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4139 "verticalScrollBars", "ScrollBars",
4142 /* Also do the stuff which must be set before the window exists. */
4143 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4144 "foreground", "Foreground", RES_TYPE_STRING
);
4145 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4146 "background", "Background", RES_TYPE_STRING
);
4147 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4148 "pointerColor", "Foreground", RES_TYPE_STRING
);
4149 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4150 "cursorColor", "Foreground", RES_TYPE_STRING
);
4151 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4152 "borderColor", "BorderColor", RES_TYPE_STRING
);
4153 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4154 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4155 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4156 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4158 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4159 "scrollBarForeground",
4160 "ScrollBarForeground", 1);
4161 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4162 "scrollBarBackground",
4163 "ScrollBarBackground", 0);
4165 /* Init faces before x_default_parameter is called for scroll-bar
4166 parameters because that function calls x_set_scroll_bar_width,
4167 which calls change_frame_size, which calls Fset_window_buffer,
4168 which runs hooks, which call Fvertical_motion. At the end, we
4169 end up in init_iterator with a null face cache, which should not
4171 init_frame_faces (f
);
4173 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4174 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4175 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4176 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4177 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4178 "bufferPredicate", "BufferPredicate",
4180 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4181 "title", "Title", RES_TYPE_STRING
);
4183 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4184 window_prompting
= x_figure_window_size (f
, parms
);
4186 if (window_prompting
& XNegative
)
4188 if (window_prompting
& YNegative
)
4189 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4191 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4195 if (window_prompting
& YNegative
)
4196 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4198 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4201 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4203 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4204 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4206 /* Create the X widget or window. Add the tool-bar height to the
4207 initial frame height so that the user gets a text display area of
4208 the size he specified with -g or via .Xdefaults. Later changes
4209 of the tool-bar height don't change the frame size. This is done
4210 so that users can create tall Emacs frames without having to
4211 guess how tall the tool-bar will get. */
4212 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4214 #ifdef USE_X_TOOLKIT
4215 x_window (f
, window_prompting
, minibuffer_only
);
4223 /* Now consider the frame official. */
4224 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4225 Vframe_list
= Fcons (frame
, Vframe_list
);
4227 /* We need to do this after creating the X window, so that the
4228 icon-creation functions can say whose icon they're describing. */
4229 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4230 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4232 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4233 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4234 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4235 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4236 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4237 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4238 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4239 "scrollBarWidth", "ScrollBarWidth",
4242 /* Dimensions, especially f->height, must be done via change_frame_size.
4243 Change will not be effected unless different from the current
4248 SET_FRAME_WIDTH (f
, 0);
4249 change_frame_size (f
, height
, width
, 1, 0, 0);
4251 /* Set up faces after all frame parameters are known. */
4252 call1 (Qface_set_after_frame_default
, frame
);
4254 #ifdef USE_X_TOOLKIT
4255 /* Create the menu bar. */
4256 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4258 /* If this signals an error, we haven't set size hints for the
4259 frame and we didn't make it visible. */
4260 initialize_frame_menubar (f
);
4262 /* This is a no-op, except under Motif where it arranges the
4263 main window for the widgets on it. */
4264 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4265 f
->output_data
.x
->menubar_widget
,
4266 f
->output_data
.x
->edit_widget
);
4268 #endif /* USE_X_TOOLKIT */
4270 /* Tell the server what size and position, etc, we want, and how
4271 badly we want them. This should be done after we have the menu
4272 bar so that its size can be taken into account. */
4274 x_wm_set_size_hint (f
, window_prompting
, 0);
4277 /* Make the window appear on the frame and enable display, unless
4278 the caller says not to. However, with explicit parent, Emacs
4279 cannot control visibility, so don't try. */
4280 if (! f
->output_data
.x
->explicit_parent
)
4282 Lisp_Object visibility
;
4284 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4286 if (EQ (visibility
, Qunbound
))
4289 if (EQ (visibility
, Qicon
))
4290 x_iconify_frame (f
);
4291 else if (! NILP (visibility
))
4292 x_make_frame_visible (f
);
4294 /* Must have been Qnil. */
4299 return unbind_to (count
, frame
);
4302 /* FRAME is used only to get a handle on the X display. We don't pass the
4303 display info directly because we're called from frame.c, which doesn't
4304 know about that structure. */
4307 x_get_focus_frame (frame
)
4308 struct frame
*frame
;
4310 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4312 if (! dpyinfo
->x_focus_frame
)
4315 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4320 /* In certain situations, when the window manager follows a
4321 click-to-focus policy, there seems to be no way around calling
4322 XSetInputFocus to give another frame the input focus .
4324 In an ideal world, XSetInputFocus should generally be avoided so
4325 that applications don't interfere with the window manager's focus
4326 policy. But I think it's okay to use when it's clearly done
4327 following a user-command. */
4329 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4330 "Set the input focus to FRAME.\n\
4331 FRAME nil means use the selected frame.")
4335 struct frame
*f
= check_x_frame (frame
);
4336 Display
*dpy
= FRAME_X_DISPLAY (f
);
4340 count
= x_catch_errors (dpy
);
4341 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4342 RevertToParent
, CurrentTime
);
4343 x_uncatch_errors (dpy
, count
);
4350 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4351 "Internal function called by `color-defined-p', which see.")
4353 Lisp_Object color
, frame
;
4356 FRAME_PTR f
= check_x_frame (frame
);
4358 CHECK_STRING (color
, 1);
4360 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4366 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4367 "Internal function called by `color-values', which see.")
4369 Lisp_Object color
, frame
;
4372 FRAME_PTR f
= check_x_frame (frame
);
4374 CHECK_STRING (color
, 1);
4376 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4380 rgb
[0] = make_number (foo
.red
);
4381 rgb
[1] = make_number (foo
.green
);
4382 rgb
[2] = make_number (foo
.blue
);
4383 return Flist (3, rgb
);
4389 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4390 "Internal function called by `display-color-p', which see.")
4392 Lisp_Object display
;
4394 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4396 if (dpyinfo
->n_planes
<= 2)
4399 switch (dpyinfo
->visual
->class)
4412 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4414 "Return t if the X display supports shades of gray.\n\
4415 Note that color displays do support shades of gray.\n\
4416 The optional argument DISPLAY specifies which display to ask about.\n\
4417 DISPLAY should be either a frame or a display name (a string).\n\
4418 If omitted or nil, that stands for the selected frame's display.")
4420 Lisp_Object display
;
4422 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4424 if (dpyinfo
->n_planes
<= 1)
4427 switch (dpyinfo
->visual
->class)
4442 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4444 "Returns the width in pixels of the X display DISPLAY.\n\
4445 The optional argument DISPLAY specifies which display to ask about.\n\
4446 DISPLAY should be either a frame or a display name (a string).\n\
4447 If omitted or nil, that stands for the selected frame's display.")
4449 Lisp_Object display
;
4451 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4453 return make_number (dpyinfo
->width
);
4456 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4457 Sx_display_pixel_height
, 0, 1, 0,
4458 "Returns the height in pixels of the X display DISPLAY.\n\
4459 The optional argument DISPLAY specifies which display to ask about.\n\
4460 DISPLAY should be either a frame or a display name (a string).\n\
4461 If omitted or nil, that stands for the selected frame's display.")
4463 Lisp_Object display
;
4465 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4467 return make_number (dpyinfo
->height
);
4470 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4472 "Returns the number of bitplanes of the X display DISPLAY.\n\
4473 The optional argument DISPLAY specifies which display to ask about.\n\
4474 DISPLAY should be either a frame or a display name (a string).\n\
4475 If omitted or nil, that stands for the selected frame's display.")
4477 Lisp_Object display
;
4479 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4481 return make_number (dpyinfo
->n_planes
);
4484 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4486 "Returns the number of color cells of the X display DISPLAY.\n\
4487 The optional argument DISPLAY specifies which display to ask about.\n\
4488 DISPLAY should be either a frame or a display name (a string).\n\
4489 If omitted or nil, that stands for the selected frame's display.")
4491 Lisp_Object display
;
4493 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4495 return make_number (DisplayCells (dpyinfo
->display
,
4496 XScreenNumberOfScreen (dpyinfo
->screen
)));
4499 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4500 Sx_server_max_request_size
,
4502 "Returns the maximum request size of the X server of display DISPLAY.\n\
4503 The optional argument DISPLAY specifies which display to ask about.\n\
4504 DISPLAY should be either a frame or a display name (a string).\n\
4505 If omitted or nil, that stands for the selected frame's display.")
4507 Lisp_Object display
;
4509 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4511 return make_number (MAXREQUEST (dpyinfo
->display
));
4514 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4515 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4516 The optional argument DISPLAY specifies which display to ask about.\n\
4517 DISPLAY should be either a frame or a display name (a string).\n\
4518 If omitted or nil, that stands for the selected frame's display.")
4520 Lisp_Object display
;
4522 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4523 char *vendor
= ServerVendor (dpyinfo
->display
);
4525 if (! vendor
) vendor
= "";
4526 return build_string (vendor
);
4529 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4530 "Returns the version numbers of the X server of display DISPLAY.\n\
4531 The value is a list of three integers: the major and minor\n\
4532 version numbers of the X Protocol in use, and the vendor-specific release\n\
4533 number. See also the function `x-server-vendor'.\n\n\
4534 The optional argument DISPLAY specifies which display to ask about.\n\
4535 DISPLAY should be either a frame or a display name (a string).\n\
4536 If omitted or nil, that stands for the selected frame's display.")
4538 Lisp_Object display
;
4540 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4541 Display
*dpy
= dpyinfo
->display
;
4543 return Fcons (make_number (ProtocolVersion (dpy
)),
4544 Fcons (make_number (ProtocolRevision (dpy
)),
4545 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4548 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4549 "Returns the number of screens on the X server of display DISPLAY.\n\
4550 The optional argument DISPLAY specifies which display to ask about.\n\
4551 DISPLAY should be either a frame or a display name (a string).\n\
4552 If omitted or nil, that stands for the selected frame's display.")
4554 Lisp_Object display
;
4556 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4558 return make_number (ScreenCount (dpyinfo
->display
));
4561 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4562 "Returns the height in millimeters of the X display DISPLAY.\n\
4563 The optional argument DISPLAY specifies which display to ask about.\n\
4564 DISPLAY should be either a frame or a display name (a string).\n\
4565 If omitted or nil, that stands for the selected frame's display.")
4567 Lisp_Object display
;
4569 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4571 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4574 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4575 "Returns the width in millimeters of the X display DISPLAY.\n\
4576 The optional argument DISPLAY specifies which display to ask about.\n\
4577 DISPLAY should be either a frame or a display name (a string).\n\
4578 If omitted or nil, that stands for the selected frame's display.")
4580 Lisp_Object display
;
4582 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4584 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4587 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4588 Sx_display_backing_store
, 0, 1, 0,
4589 "Returns an indication of whether X display DISPLAY does backing store.\n\
4590 The value may be `always', `when-mapped', or `not-useful'.\n\
4591 The optional argument DISPLAY specifies which display to ask about.\n\
4592 DISPLAY should be either a frame or a display name (a string).\n\
4593 If omitted or nil, that stands for the selected frame's display.")
4595 Lisp_Object display
;
4597 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4600 switch (DoesBackingStore (dpyinfo
->screen
))
4603 result
= intern ("always");
4607 result
= intern ("when-mapped");
4611 result
= intern ("not-useful");
4615 error ("Strange value for BackingStore parameter of screen");
4622 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4623 Sx_display_visual_class
, 0, 1, 0,
4624 "Returns the visual class of the X display DISPLAY.\n\
4625 The value is one of the symbols `static-gray', `gray-scale',\n\
4626 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4627 The optional argument DISPLAY specifies which display to ask about.\n\
4628 DISPLAY should be either a frame or a display name (a string).\n\
4629 If omitted or nil, that stands for the selected frame's display.")
4631 Lisp_Object display
;
4633 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4636 switch (dpyinfo
->visual
->class)
4639 result
= intern ("static-gray");
4642 result
= intern ("gray-scale");
4645 result
= intern ("static-color");
4648 result
= intern ("pseudo-color");
4651 result
= intern ("true-color");
4654 result
= intern ("direct-color");
4657 error ("Display has an unknown visual class");
4664 DEFUN ("x-display-save-under", Fx_display_save_under
,
4665 Sx_display_save_under
, 0, 1, 0,
4666 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4667 The optional argument DISPLAY specifies which display to ask about.\n\
4668 DISPLAY should be either a frame or a display name (a string).\n\
4669 If omitted or nil, that stands for the selected frame's display.")
4671 Lisp_Object display
;
4673 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4675 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4683 register struct frame
*f
;
4685 return PIXEL_WIDTH (f
);
4690 register struct frame
*f
;
4692 return PIXEL_HEIGHT (f
);
4697 register struct frame
*f
;
4699 return FONT_WIDTH (f
->output_data
.x
->font
);
4704 register struct frame
*f
;
4706 return f
->output_data
.x
->line_height
;
4711 register struct frame
*f
;
4713 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4718 /************************************************************************
4720 ************************************************************************/
4723 /* Mapping visual names to visuals. */
4725 static struct visual_class
4732 {"StaticGray", StaticGray
},
4733 {"GrayScale", GrayScale
},
4734 {"StaticColor", StaticColor
},
4735 {"PseudoColor", PseudoColor
},
4736 {"TrueColor", TrueColor
},
4737 {"DirectColor", DirectColor
},
4742 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4744 /* Value is the screen number of screen SCR. This is a substitute for
4745 the X function with the same name when that doesn't exist. */
4748 XScreenNumberOfScreen (scr
)
4749 register Screen
*scr
;
4751 Display
*dpy
= scr
->display
;
4754 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4755 if (scr
== dpy
->screens
[i
])
4761 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4764 /* Select the visual that should be used on display DPYINFO. Set
4765 members of DPYINFO appropriately. Called from x_term_init. */
4768 select_visual (dpyinfo
)
4769 struct x_display_info
*dpyinfo
;
4771 Display
*dpy
= dpyinfo
->display
;
4772 Screen
*screen
= dpyinfo
->screen
;
4775 /* See if a visual is specified. */
4776 value
= display_x_get_resource (dpyinfo
,
4777 build_string ("visualClass"),
4778 build_string ("VisualClass"),
4780 if (STRINGP (value
))
4782 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4783 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4784 depth, a decimal number. NAME is compared with case ignored. */
4785 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4790 strcpy (s
, XSTRING (value
)->data
);
4791 dash
= index (s
, '-');
4794 dpyinfo
->n_planes
= atoi (dash
+ 1);
4798 /* We won't find a matching visual with depth 0, so that
4799 an error will be printed below. */
4800 dpyinfo
->n_planes
= 0;
4802 /* Determine the visual class. */
4803 for (i
= 0; visual_classes
[i
].name
; ++i
)
4804 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4806 class = visual_classes
[i
].class;
4810 /* Look up a matching visual for the specified class. */
4812 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4813 dpyinfo
->n_planes
, class, &vinfo
))
4814 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4816 dpyinfo
->visual
= vinfo
.visual
;
4821 XVisualInfo
*vinfo
, vinfo_template
;
4823 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4826 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4828 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4830 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4831 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4832 &vinfo_template
, &n_visuals
);
4834 fatal ("Can't get proper X visual info");
4836 dpyinfo
->n_planes
= vinfo
->depth
;
4837 XFree ((char *) vinfo
);
4842 /* Return the X display structure for the display named NAME.
4843 Open a new connection if necessary. */
4845 struct x_display_info
*
4846 x_display_info_for_name (name
)
4850 struct x_display_info
*dpyinfo
;
4852 CHECK_STRING (name
, 0);
4854 if (! EQ (Vwindow_system
, intern ("x")))
4855 error ("Not using X Windows");
4857 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4859 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4862 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4867 /* Use this general default value to start with. */
4868 Vx_resource_name
= Vinvocation_name
;
4870 validate_x_resource_name ();
4872 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4873 (char *) XSTRING (Vx_resource_name
)->data
);
4876 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4879 XSETFASTINT (Vwindow_system_version
, 11);
4885 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4886 1, 3, 0, "Open a connection to an X server.\n\
4887 DISPLAY is the name of the display to connect to.\n\
4888 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4889 If the optional third arg MUST-SUCCEED is non-nil,\n\
4890 terminate Emacs if we can't open the connection.")
4891 (display
, xrm_string
, must_succeed
)
4892 Lisp_Object display
, xrm_string
, must_succeed
;
4894 unsigned char *xrm_option
;
4895 struct x_display_info
*dpyinfo
;
4897 CHECK_STRING (display
, 0);
4898 if (! NILP (xrm_string
))
4899 CHECK_STRING (xrm_string
, 1);
4901 if (! EQ (Vwindow_system
, intern ("x")))
4902 error ("Not using X Windows");
4904 if (! NILP (xrm_string
))
4905 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4907 xrm_option
= (unsigned char *) 0;
4909 validate_x_resource_name ();
4911 /* This is what opens the connection and sets x_current_display.
4912 This also initializes many symbols, such as those used for input. */
4913 dpyinfo
= x_term_init (display
, xrm_option
,
4914 (char *) XSTRING (Vx_resource_name
)->data
);
4918 if (!NILP (must_succeed
))
4919 fatal ("Cannot connect to X server %s.\n\
4920 Check the DISPLAY environment variable or use `-d'.\n\
4921 Also use the `xhost' program to verify that it is set to permit\n\
4922 connections from your machine.\n",
4923 XSTRING (display
)->data
);
4925 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4930 XSETFASTINT (Vwindow_system_version
, 11);
4934 DEFUN ("x-close-connection", Fx_close_connection
,
4935 Sx_close_connection
, 1, 1, 0,
4936 "Close the connection to DISPLAY's X server.\n\
4937 For DISPLAY, specify either a frame or a display name (a string).\n\
4938 If DISPLAY is nil, that stands for the selected frame's display.")
4940 Lisp_Object display
;
4942 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4945 if (dpyinfo
->reference_count
> 0)
4946 error ("Display still has frames on it");
4949 /* Free the fonts in the font table. */
4950 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4951 if (dpyinfo
->font_table
[i
].name
)
4953 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4954 xfree (dpyinfo
->font_table
[i
].full_name
);
4955 xfree (dpyinfo
->font_table
[i
].name
);
4956 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4959 x_destroy_all_bitmaps (dpyinfo
);
4960 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4962 #ifdef USE_X_TOOLKIT
4963 XtCloseDisplay (dpyinfo
->display
);
4965 XCloseDisplay (dpyinfo
->display
);
4968 x_delete_display (dpyinfo
);
4974 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4975 "Return the list of display names that Emacs has connections to.")
4978 Lisp_Object tail
, result
;
4981 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4982 result
= Fcons (XCAR (XCAR (tail
)), result
);
4987 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4988 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4989 If ON is nil, allow buffering of requests.\n\
4990 Turning on synchronization prohibits the Xlib routines from buffering\n\
4991 requests and seriously degrades performance, but makes debugging much\n\
4993 The optional second argument DISPLAY specifies which display to act on.\n\
4994 DISPLAY should be either a frame or a display name (a string).\n\
4995 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4997 Lisp_Object display
, on
;
4999 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5001 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5006 /* Wait for responses to all X commands issued so far for frame F. */
5013 XSync (FRAME_X_DISPLAY (f
), False
);
5018 /***********************************************************************
5020 ***********************************************************************/
5022 /* Value is the number of elements of vector VECTOR. */
5024 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5026 /* List of supported image types. Use define_image_type to add new
5027 types. Use lookup_image_type to find a type for a given symbol. */
5029 static struct image_type
*image_types
;
5031 /* The symbol `image' which is the car of the lists used to represent
5034 extern Lisp_Object Qimage
;
5036 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5042 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5043 extern Lisp_Object QCdata
;
5044 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5045 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5046 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5048 /* Other symbols. */
5050 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5052 /* Time in seconds after which images should be removed from the cache
5053 if not displayed. */
5055 Lisp_Object Vimage_cache_eviction_delay
;
5057 /* Function prototypes. */
5059 static void define_image_type
P_ ((struct image_type
*type
));
5060 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5061 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5062 static void x_laplace
P_ ((struct frame
*, struct image
*));
5063 static void x_emboss
P_ ((struct frame
*, struct image
*));
5064 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5068 /* Define a new image type from TYPE. This adds a copy of TYPE to
5069 image_types and adds the symbol *TYPE->type to Vimage_types. */
5072 define_image_type (type
)
5073 struct image_type
*type
;
5075 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5076 The initialized data segment is read-only. */
5077 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5078 bcopy (type
, p
, sizeof *p
);
5079 p
->next
= image_types
;
5081 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5085 /* Look up image type SYMBOL, and return a pointer to its image_type
5086 structure. Value is null if SYMBOL is not a known image type. */
5088 static INLINE
struct image_type
*
5089 lookup_image_type (symbol
)
5092 struct image_type
*type
;
5094 for (type
= image_types
; type
; type
= type
->next
)
5095 if (EQ (symbol
, *type
->type
))
5102 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5103 valid image specification is a list whose car is the symbol
5104 `image', and whose rest is a property list. The property list must
5105 contain a value for key `:type'. That value must be the name of a
5106 supported image type. The rest of the property list depends on the
5110 valid_image_p (object
)
5115 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5117 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5118 struct image_type
*type
= lookup_image_type (symbol
);
5121 valid_p
= type
->valid_p (object
);
5128 /* Log error message with format string FORMAT and argument ARG.
5129 Signaling an error, e.g. when an image cannot be loaded, is not a
5130 good idea because this would interrupt redisplay, and the error
5131 message display would lead to another redisplay. This function
5132 therefore simply displays a message. */
5135 image_error (format
, arg1
, arg2
)
5137 Lisp_Object arg1
, arg2
;
5139 add_to_log (format
, arg1
, arg2
);
5144 /***********************************************************************
5145 Image specifications
5146 ***********************************************************************/
5148 enum image_value_type
5150 IMAGE_DONT_CHECK_VALUE_TYPE
,
5153 IMAGE_POSITIVE_INTEGER_VALUE
,
5154 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5156 IMAGE_INTEGER_VALUE
,
5157 IMAGE_FUNCTION_VALUE
,
5162 /* Structure used when parsing image specifications. */
5164 struct image_keyword
5166 /* Name of keyword. */
5169 /* The type of value allowed. */
5170 enum image_value_type type
;
5172 /* Non-zero means key must be present. */
5175 /* Used to recognize duplicate keywords in a property list. */
5178 /* The value that was found. */
5183 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5185 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5188 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5189 has the format (image KEYWORD VALUE ...). One of the keyword/
5190 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5191 image_keywords structures of size NKEYWORDS describing other
5192 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5195 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5197 struct image_keyword
*keywords
;
5204 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5207 plist
= XCDR (spec
);
5208 while (CONSP (plist
))
5210 Lisp_Object key
, value
;
5212 /* First element of a pair must be a symbol. */
5214 plist
= XCDR (plist
);
5218 /* There must follow a value. */
5221 value
= XCAR (plist
);
5222 plist
= XCDR (plist
);
5224 /* Find key in KEYWORDS. Error if not found. */
5225 for (i
= 0; i
< nkeywords
; ++i
)
5226 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5232 /* Record that we recognized the keyword. If a keywords
5233 was found more than once, it's an error. */
5234 keywords
[i
].value
= value
;
5235 ++keywords
[i
].count
;
5237 if (keywords
[i
].count
> 1)
5240 /* Check type of value against allowed type. */
5241 switch (keywords
[i
].type
)
5243 case IMAGE_STRING_VALUE
:
5244 if (!STRINGP (value
))
5248 case IMAGE_SYMBOL_VALUE
:
5249 if (!SYMBOLP (value
))
5253 case IMAGE_POSITIVE_INTEGER_VALUE
:
5254 if (!INTEGERP (value
) || XINT (value
) <= 0)
5258 case IMAGE_ASCENT_VALUE
:
5259 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5261 else if (INTEGERP (value
)
5262 && XINT (value
) >= 0
5263 && XINT (value
) <= 100)
5267 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5268 if (!INTEGERP (value
) || XINT (value
) < 0)
5272 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5275 case IMAGE_FUNCTION_VALUE
:
5276 value
= indirect_function (value
);
5278 || COMPILEDP (value
)
5279 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5283 case IMAGE_NUMBER_VALUE
:
5284 if (!INTEGERP (value
) && !FLOATP (value
))
5288 case IMAGE_INTEGER_VALUE
:
5289 if (!INTEGERP (value
))
5293 case IMAGE_BOOL_VALUE
:
5294 if (!NILP (value
) && !EQ (value
, Qt
))
5303 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5307 /* Check that all mandatory fields are present. */
5308 for (i
= 0; i
< nkeywords
; ++i
)
5309 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5312 return NILP (plist
);
5316 /* Return the value of KEY in image specification SPEC. Value is nil
5317 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5318 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5321 image_spec_value (spec
, key
, found
)
5322 Lisp_Object spec
, key
;
5327 xassert (valid_image_p (spec
));
5329 for (tail
= XCDR (spec
);
5330 CONSP (tail
) && CONSP (XCDR (tail
));
5331 tail
= XCDR (XCDR (tail
)))
5333 if (EQ (XCAR (tail
), key
))
5337 return XCAR (XCDR (tail
));
5347 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5348 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5349 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5350 size in canonical character units.\n\
5351 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5352 or omitted means use the selected frame.")
5353 (spec
, pixels
, frame
)
5354 Lisp_Object spec
, pixels
, frame
;
5359 if (valid_image_p (spec
))
5361 struct frame
*f
= check_x_frame (frame
);
5362 int id
= lookup_image (f
, spec
);
5363 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5364 int width
= img
->width
+ 2 * img
->margin
;
5365 int height
= img
->height
+ 2 * img
->margin
;
5368 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5369 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5371 size
= Fcons (make_number (width
), make_number (height
));
5374 error ("Invalid image specification");
5380 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5381 "Return t if image SPEC has a mask bitmap.\n\
5382 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5383 or omitted means use the selected frame.")
5385 Lisp_Object spec
, frame
;
5390 if (valid_image_p (spec
))
5392 struct frame
*f
= check_x_frame (frame
);
5393 int id
= lookup_image (f
, spec
);
5394 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5399 error ("Invalid image specification");
5406 /***********************************************************************
5407 Image type independent image structures
5408 ***********************************************************************/
5410 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5411 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5414 /* Allocate and return a new image structure for image specification
5415 SPEC. SPEC has a hash value of HASH. */
5417 static struct image
*
5418 make_image (spec
, hash
)
5422 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5424 xassert (valid_image_p (spec
));
5425 bzero (img
, sizeof *img
);
5426 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5427 xassert (img
->type
!= NULL
);
5429 img
->data
.lisp_val
= Qnil
;
5430 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5436 /* Free image IMG which was used on frame F, including its resources. */
5445 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5447 /* Remove IMG from the hash table of its cache. */
5449 img
->prev
->next
= img
->next
;
5451 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5454 img
->next
->prev
= img
->prev
;
5456 c
->images
[img
->id
] = NULL
;
5458 /* Free resources, then free IMG. */
5459 img
->type
->free (f
, img
);
5465 /* Prepare image IMG for display on frame F. Must be called before
5466 drawing an image. */
5469 prepare_image_for_display (f
, img
)
5475 /* We're about to display IMG, so set its timestamp to `now'. */
5477 img
->timestamp
= EMACS_SECS (t
);
5479 /* If IMG doesn't have a pixmap yet, load it now, using the image
5480 type dependent loader function. */
5481 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5482 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5486 /* Value is the number of pixels for the ascent of image IMG when
5487 drawn in face FACE. */
5490 image_ascent (img
, face
)
5494 int height
= img
->height
+ img
->margin
;
5497 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5500 ascent
= height
/ 2 - (face
->font
->descent
- face
->font
->ascent
) / 2;
5502 ascent
= height
/ 2;
5505 ascent
= height
* img
->ascent
/ 100.0;
5512 /***********************************************************************
5513 Helper functions for X image types
5514 ***********************************************************************/
5516 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5517 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5519 Lisp_Object color_name
,
5520 unsigned long dflt
));
5522 /* Free X resources of image IMG which is used on frame F. */
5525 x_clear_image (f
, img
)
5533 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5539 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5545 x_free_colors (f
, img
->colors
, img
->ncolors
);
5546 xfree (img
->colors
);
5555 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5556 cannot be allocated, use DFLT. Add a newly allocated color to
5557 IMG->colors, so that it can be freed again. Value is the pixel
5560 static unsigned long
5561 x_alloc_image_color (f
, img
, color_name
, dflt
)
5564 Lisp_Object color_name
;
5568 unsigned long result
;
5570 xassert (STRINGP (color_name
));
5572 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5574 /* This isn't called frequently so we get away with simply
5575 reallocating the color vector to the needed size, here. */
5578 (unsigned long *) xrealloc (img
->colors
,
5579 img
->ncolors
* sizeof *img
->colors
);
5580 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5581 result
= color
.pixel
;
5591 /***********************************************************************
5593 ***********************************************************************/
5595 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5598 /* Return a new, initialized image cache that is allocated from the
5599 heap. Call free_image_cache to free an image cache. */
5601 struct image_cache
*
5604 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5607 bzero (c
, sizeof *c
);
5609 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5610 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5611 c
->buckets
= (struct image
**) xmalloc (size
);
5612 bzero (c
->buckets
, size
);
5617 /* Free image cache of frame F. Be aware that X frames share images
5621 free_image_cache (f
)
5624 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5629 /* Cache should not be referenced by any frame when freed. */
5630 xassert (c
->refcount
== 0);
5632 for (i
= 0; i
< c
->used
; ++i
)
5633 free_image (f
, c
->images
[i
]);
5637 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5642 /* Clear image cache of frame F. FORCE_P non-zero means free all
5643 images. FORCE_P zero means clear only images that haven't been
5644 displayed for some time. Should be called from time to time to
5645 reduce the number of loaded images. If image-eviction-seconds is
5646 non-nil, this frees images in the cache which weren't displayed for
5647 at least that many seconds. */
5650 clear_image_cache (f
, force_p
)
5654 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5656 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5663 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5665 /* Block input so that we won't be interrupted by a SIGIO
5666 while being in an inconsistent state. */
5669 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5671 struct image
*img
= c
->images
[i
];
5673 && (force_p
|| img
->timestamp
< old
))
5675 free_image (f
, img
);
5680 /* We may be clearing the image cache because, for example,
5681 Emacs was iconified for a longer period of time. In that
5682 case, current matrices may still contain references to
5683 images freed above. So, clear these matrices. */
5686 Lisp_Object tail
, frame
;
5688 FOR_EACH_FRAME (tail
, frame
)
5690 struct frame
*f
= XFRAME (frame
);
5692 && FRAME_X_IMAGE_CACHE (f
) == c
)
5693 clear_current_matrices (f
);
5696 ++windows_or_buffers_changed
;
5704 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5706 "Clear the image cache of FRAME.\n\
5707 FRAME nil or omitted means use the selected frame.\n\
5708 FRAME t means clear the image caches of all frames.")
5716 FOR_EACH_FRAME (tail
, frame
)
5717 if (FRAME_X_P (XFRAME (frame
)))
5718 clear_image_cache (XFRAME (frame
), 1);
5721 clear_image_cache (check_x_frame (frame
), 1);
5727 /* Return the id of image with Lisp specification SPEC on frame F.
5728 SPEC must be a valid Lisp image specification (see valid_image_p). */
5731 lookup_image (f
, spec
)
5735 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5739 struct gcpro gcpro1
;
5742 /* F must be a window-system frame, and SPEC must be a valid image
5744 xassert (FRAME_WINDOW_P (f
));
5745 xassert (valid_image_p (spec
));
5749 /* Look up SPEC in the hash table of the image cache. */
5750 hash
= sxhash (spec
, 0);
5751 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5753 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5754 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5757 /* If not found, create a new image and cache it. */
5761 img
= make_image (spec
, hash
);
5762 cache_image (f
, img
);
5763 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5765 /* If we can't load the image, and we don't have a width and
5766 height, use some arbitrary width and height so that we can
5767 draw a rectangle for it. */
5768 if (img
->load_failed_p
)
5772 value
= image_spec_value (spec
, QCwidth
, NULL
);
5773 img
->width
= (INTEGERP (value
)
5774 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5775 value
= image_spec_value (spec
, QCheight
, NULL
);
5776 img
->height
= (INTEGERP (value
)
5777 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5781 /* Handle image type independent image attributes
5782 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5783 Lisp_Object ascent
, margin
, relief
;
5786 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5787 if (INTEGERP (ascent
))
5788 img
->ascent
= XFASTINT (ascent
);
5789 else if (EQ (ascent
, Qcenter
))
5790 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5792 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5793 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5794 img
->margin
= XFASTINT (margin
);
5796 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5797 if (INTEGERP (relief
))
5799 img
->relief
= XINT (relief
);
5800 img
->margin
+= abs (img
->relief
);
5803 /* Manipulation of the image's mask. */
5806 /* `:heuristic-mask t'
5808 means build a mask heuristically.
5809 `:heuristic-mask (R G B)'
5810 `:mask (heuristic (R G B))'
5811 means build a mask from color (R G B) in the
5814 means remove a mask, if any. */
5818 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5820 x_build_heuristic_mask (f
, img
, mask
);
5825 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5827 if (EQ (mask
, Qheuristic
))
5828 x_build_heuristic_mask (f
, img
, Qt
);
5829 else if (CONSP (mask
)
5830 && EQ (XCAR (mask
), Qheuristic
))
5832 if (CONSP (XCDR (mask
)))
5833 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5835 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5837 else if (NILP (mask
) && found_p
&& img
->mask
)
5839 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5845 /* Should we apply an image transformation algorithm? */
5848 Lisp_Object algorithm
;
5850 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5851 if (EQ (algorithm
, Qdisabled
))
5852 x_disable_image (f
, img
);
5853 else if (EQ (algorithm
, Qlaplace
))
5855 else if (EQ (algorithm
, Qemboss
))
5857 else if (CONSP (algorithm
)
5858 && EQ (XCAR (algorithm
), Qedge_detection
))
5861 tem
= XCDR (algorithm
);
5863 x_edge_detection (f
, img
,
5864 Fplist_get (tem
, QCmatrix
),
5865 Fplist_get (tem
, QCcolor_adjustment
));
5872 xassert (!interrupt_input_blocked
);
5875 /* We're using IMG, so set its timestamp to `now'. */
5876 EMACS_GET_TIME (now
);
5877 img
->timestamp
= EMACS_SECS (now
);
5881 /* Value is the image id. */
5886 /* Cache image IMG in the image cache of frame F. */
5889 cache_image (f
, img
)
5893 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5896 /* Find a free slot in c->images. */
5897 for (i
= 0; i
< c
->used
; ++i
)
5898 if (c
->images
[i
] == NULL
)
5901 /* If no free slot found, maybe enlarge c->images. */
5902 if (i
== c
->used
&& c
->used
== c
->size
)
5905 c
->images
= (struct image
**) xrealloc (c
->images
,
5906 c
->size
* sizeof *c
->images
);
5909 /* Add IMG to c->images, and assign IMG an id. */
5915 /* Add IMG to the cache's hash table. */
5916 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5917 img
->next
= c
->buckets
[i
];
5919 img
->next
->prev
= img
;
5921 c
->buckets
[i
] = img
;
5925 /* Call FN on every image in the image cache of frame F. Used to mark
5926 Lisp Objects in the image cache. */
5929 forall_images_in_image_cache (f
, fn
)
5931 void (*fn
) P_ ((struct image
*img
));
5933 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5935 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5939 for (i
= 0; i
< c
->used
; ++i
)
5948 /***********************************************************************
5950 ***********************************************************************/
5952 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5953 XImage
**, Pixmap
*));
5954 static void x_destroy_x_image
P_ ((XImage
*));
5955 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5958 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5959 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5960 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5961 via xmalloc. Print error messages via image_error if an error
5962 occurs. Value is non-zero if successful. */
5965 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5967 int width
, height
, depth
;
5971 Display
*display
= FRAME_X_DISPLAY (f
);
5972 Screen
*screen
= FRAME_X_SCREEN (f
);
5973 Window window
= FRAME_X_WINDOW (f
);
5975 xassert (interrupt_input_blocked
);
5978 depth
= DefaultDepthOfScreen (screen
);
5979 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5980 depth
, ZPixmap
, 0, NULL
, width
, height
,
5981 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5984 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5988 /* Allocate image raster. */
5989 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5991 /* Allocate a pixmap of the same size. */
5992 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5995 x_destroy_x_image (*ximg
);
5997 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6005 /* Destroy XImage XIMG. Free XIMG->data. */
6008 x_destroy_x_image (ximg
)
6011 xassert (interrupt_input_blocked
);
6016 XDestroyImage (ximg
);
6021 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6022 are width and height of both the image and pixmap. */
6025 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6032 xassert (interrupt_input_blocked
);
6033 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6034 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6035 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6040 /***********************************************************************
6042 ***********************************************************************/
6044 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6045 static char *slurp_file
P_ ((char *, int *));
6048 /* Find image file FILE. Look in data-directory, then
6049 x-bitmap-file-path. Value is the full name of the file found, or
6050 nil if not found. */
6053 x_find_image_file (file
)
6056 Lisp_Object file_found
, search_path
;
6057 struct gcpro gcpro1
, gcpro2
;
6061 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6062 GCPRO2 (file_found
, search_path
);
6064 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6065 fd
= openp (search_path
, file
, "", &file_found
, 0);
6077 /* Read FILE into memory. Value is a pointer to a buffer allocated
6078 with xmalloc holding FILE's contents. Value is null if an error
6079 occurred. *SIZE is set to the size of the file. */
6082 slurp_file (file
, size
)
6090 if (stat (file
, &st
) == 0
6091 && (fp
= fopen (file
, "r")) != NULL
6092 && (buf
= (char *) xmalloc (st
.st_size
),
6093 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6114 /***********************************************************************
6116 ***********************************************************************/
6118 static int xbm_scan
P_ ((char **, char *, char *, int *));
6119 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6120 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6122 static int xbm_image_p
P_ ((Lisp_Object object
));
6123 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6125 static int xbm_file_p
P_ ((Lisp_Object
));
6128 /* Indices of image specification fields in xbm_format, below. */
6130 enum xbm_keyword_index
6148 /* Vector of image_keyword structures describing the format
6149 of valid XBM image specifications. */
6151 static struct image_keyword xbm_format
[XBM_LAST
] =
6153 {":type", IMAGE_SYMBOL_VALUE
, 1},
6154 {":file", IMAGE_STRING_VALUE
, 0},
6155 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6156 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6157 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6158 {":foreground", IMAGE_STRING_VALUE
, 0},
6159 {":background", IMAGE_STRING_VALUE
, 0},
6160 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6161 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6162 {":relief", IMAGE_INTEGER_VALUE
, 0},
6163 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6164 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6165 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6168 /* Structure describing the image type XBM. */
6170 static struct image_type xbm_type
=
6179 /* Tokens returned from xbm_scan. */
6188 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6189 A valid specification is a list starting with the symbol `image'
6190 The rest of the list is a property list which must contain an
6193 If the specification specifies a file to load, it must contain
6194 an entry `:file FILENAME' where FILENAME is a string.
6196 If the specification is for a bitmap loaded from memory it must
6197 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6198 WIDTH and HEIGHT are integers > 0. DATA may be:
6200 1. a string large enough to hold the bitmap data, i.e. it must
6201 have a size >= (WIDTH + 7) / 8 * HEIGHT
6203 2. a bool-vector of size >= WIDTH * HEIGHT
6205 3. a vector of strings or bool-vectors, one for each line of the
6208 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6209 may not be specified in this case because they are defined in the
6212 Both the file and data forms may contain the additional entries
6213 `:background COLOR' and `:foreground COLOR'. If not present,
6214 foreground and background of the frame on which the image is
6215 displayed is used. */
6218 xbm_image_p (object
)
6221 struct image_keyword kw
[XBM_LAST
];
6223 bcopy (xbm_format
, kw
, sizeof kw
);
6224 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6227 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6229 if (kw
[XBM_FILE
].count
)
6231 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6234 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6236 /* In-memory XBM file. */
6237 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6245 /* Entries for `:width', `:height' and `:data' must be present. */
6246 if (!kw
[XBM_WIDTH
].count
6247 || !kw
[XBM_HEIGHT
].count
6248 || !kw
[XBM_DATA
].count
)
6251 data
= kw
[XBM_DATA
].value
;
6252 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6253 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6255 /* Check type of data, and width and height against contents of
6261 /* Number of elements of the vector must be >= height. */
6262 if (XVECTOR (data
)->size
< height
)
6265 /* Each string or bool-vector in data must be large enough
6266 for one line of the image. */
6267 for (i
= 0; i
< height
; ++i
)
6269 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6273 if (XSTRING (elt
)->size
6274 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6277 else if (BOOL_VECTOR_P (elt
))
6279 if (XBOOL_VECTOR (elt
)->size
< width
)
6286 else if (STRINGP (data
))
6288 if (XSTRING (data
)->size
6289 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6292 else if (BOOL_VECTOR_P (data
))
6294 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6305 /* Scan a bitmap file. FP is the stream to read from. Value is
6306 either an enumerator from enum xbm_token, or a character for a
6307 single-character token, or 0 at end of file. If scanning an
6308 identifier, store the lexeme of the identifier in SVAL. If
6309 scanning a number, store its value in *IVAL. */
6312 xbm_scan (s
, end
, sval
, ival
)
6319 /* Skip white space. */
6320 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6325 else if (isdigit (c
))
6327 int value
= 0, digit
;
6329 if (c
== '0' && *s
< end
)
6332 if (c
== 'x' || c
== 'X')
6339 else if (c
>= 'a' && c
<= 'f')
6340 digit
= c
- 'a' + 10;
6341 else if (c
>= 'A' && c
<= 'F')
6342 digit
= c
- 'A' + 10;
6345 value
= 16 * value
+ digit
;
6348 else if (isdigit (c
))
6352 && (c
= *(*s
)++, isdigit (c
)))
6353 value
= 8 * value
+ c
- '0';
6360 && (c
= *(*s
)++, isdigit (c
)))
6361 value
= 10 * value
+ c
- '0';
6369 else if (isalpha (c
) || c
== '_')
6373 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6385 /* Replacement for XReadBitmapFileData which isn't available under old
6386 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6387 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6388 the image. Return in *DATA the bitmap data allocated with xmalloc.
6389 Value is non-zero if successful. DATA null means just test if
6390 CONTENTS looks like an in-memory XBM file. */
6393 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6394 char *contents
, *end
;
6395 int *width
, *height
;
6396 unsigned char **data
;
6399 char buffer
[BUFSIZ
];
6402 int bytes_per_line
, i
, nbytes
;
6408 LA1 = xbm_scan (&s, end, buffer, &value)
6410 #define expect(TOKEN) \
6411 if (LA1 != (TOKEN)) \
6416 #define expect_ident(IDENT) \
6417 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6422 *width
= *height
= -1;
6425 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6427 /* Parse defines for width, height and hot-spots. */
6431 expect_ident ("define");
6432 expect (XBM_TK_IDENT
);
6434 if (LA1
== XBM_TK_NUMBER
);
6436 char *p
= strrchr (buffer
, '_');
6437 p
= p
? p
+ 1 : buffer
;
6438 if (strcmp (p
, "width") == 0)
6440 else if (strcmp (p
, "height") == 0)
6443 expect (XBM_TK_NUMBER
);
6446 if (*width
< 0 || *height
< 0)
6448 else if (data
== NULL
)
6451 /* Parse bits. Must start with `static'. */
6452 expect_ident ("static");
6453 if (LA1
== XBM_TK_IDENT
)
6455 if (strcmp (buffer
, "unsigned") == 0)
6458 expect_ident ("char");
6460 else if (strcmp (buffer
, "short") == 0)
6464 if (*width
% 16 && *width
% 16 < 9)
6467 else if (strcmp (buffer
, "char") == 0)
6475 expect (XBM_TK_IDENT
);
6481 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6482 nbytes
= bytes_per_line
* *height
;
6483 p
= *data
= (char *) xmalloc (nbytes
);
6487 for (i
= 0; i
< nbytes
; i
+= 2)
6490 expect (XBM_TK_NUMBER
);
6493 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6496 if (LA1
== ',' || LA1
== '}')
6504 for (i
= 0; i
< nbytes
; ++i
)
6507 expect (XBM_TK_NUMBER
);
6511 if (LA1
== ',' || LA1
== '}')
6536 /* Load XBM image IMG which will be displayed on frame F from buffer
6537 CONTENTS. END is the end of the buffer. Value is non-zero if
6541 xbm_load_image (f
, img
, contents
, end
)
6544 char *contents
, *end
;
6547 unsigned char *data
;
6550 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6553 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6554 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6555 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6558 xassert (img
->width
> 0 && img
->height
> 0);
6560 /* Get foreground and background colors, maybe allocate colors. */
6561 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6563 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6565 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6567 background
= x_alloc_image_color (f
, img
, value
, background
);
6570 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6573 img
->width
, img
->height
,
6574 foreground
, background
,
6578 if (img
->pixmap
== 0)
6580 x_clear_image (f
, img
);
6581 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6587 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6593 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6600 return (STRINGP (data
)
6601 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6602 (XSTRING (data
)->data
6603 + STRING_BYTES (XSTRING (data
))),
6608 /* Fill image IMG which is used on frame F with pixmap data. Value is
6609 non-zero if successful. */
6617 Lisp_Object file_name
;
6619 xassert (xbm_image_p (img
->spec
));
6621 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6622 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6623 if (STRINGP (file_name
))
6628 struct gcpro gcpro1
;
6630 file
= x_find_image_file (file_name
);
6632 if (!STRINGP (file
))
6634 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6639 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6640 if (contents
== NULL
)
6642 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6647 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6652 struct image_keyword fmt
[XBM_LAST
];
6654 unsigned char *bitmap_data
;
6656 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6657 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6659 int parsed_p
, height
, width
;
6660 int in_memory_file_p
= 0;
6662 /* See if data looks like an in-memory XBM file. */
6663 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6664 in_memory_file_p
= xbm_file_p (data
);
6666 /* Parse the image specification. */
6667 bcopy (xbm_format
, fmt
, sizeof fmt
);
6668 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6671 /* Get specified width, and height. */
6672 if (!in_memory_file_p
)
6674 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6675 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6676 xassert (img
->width
> 0 && img
->height
> 0);
6679 /* Get foreground and background colors, maybe allocate colors. */
6680 if (fmt
[XBM_FOREGROUND
].count
)
6681 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6683 if (fmt
[XBM_BACKGROUND
].count
)
6684 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6687 if (in_memory_file_p
)
6688 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6689 (XSTRING (data
)->data
6690 + STRING_BYTES (XSTRING (data
))));
6697 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6699 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6700 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6702 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6704 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6706 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6709 else if (STRINGP (data
))
6710 bits
= XSTRING (data
)->data
;
6712 bits
= XBOOL_VECTOR (data
)->data
;
6714 /* Create the pixmap. */
6715 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6717 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6720 img
->width
, img
->height
,
6721 foreground
, background
,
6727 image_error ("Unable to create pixmap for XBM image `%s'",
6729 x_clear_image (f
, img
);
6739 /***********************************************************************
6741 ***********************************************************************/
6745 static int xpm_image_p
P_ ((Lisp_Object object
));
6746 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6747 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6749 #include "X11/xpm.h"
6751 /* The symbol `xpm' identifying XPM-format images. */
6755 /* Indices of image specification fields in xpm_format, below. */
6757 enum xpm_keyword_index
6772 /* Vector of image_keyword structures describing the format
6773 of valid XPM image specifications. */
6775 static struct image_keyword xpm_format
[XPM_LAST
] =
6777 {":type", IMAGE_SYMBOL_VALUE
, 1},
6778 {":file", IMAGE_STRING_VALUE
, 0},
6779 {":data", IMAGE_STRING_VALUE
, 0},
6780 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6781 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6782 {":relief", IMAGE_INTEGER_VALUE
, 0},
6783 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6784 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6785 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6786 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6789 /* Structure describing the image type XBM. */
6791 static struct image_type xpm_type
=
6801 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6802 functions for allocating image colors. Our own functions handle
6803 color allocation failures more gracefully than the ones on the XPM
6806 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6807 #define ALLOC_XPM_COLORS
6810 #ifdef ALLOC_XPM_COLORS
6812 static void xpm_init_color_cache
P_ ((void));
6813 static void xpm_free_color_cache
P_ ((void));
6814 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6816 /* An entry in a hash table used to cache color definitions of named
6817 colors. This cache is necessary to speed up XPM image loading in
6818 case we do color allocations ourselves. Without it, we would need
6819 a call to XParseColor per pixel in the image. */
6821 struct xpm_cached_color
6823 /* Next in collision chain. */
6824 struct xpm_cached_color
*next
;
6826 /* Color definition (RGB and pixel color). */
6833 /* The hash table used for the color cache, and its bucket vector
6836 #define XPM_COLOR_CACHE_BUCKETS 1001
6837 struct xpm_cached_color
**xpm_color_cache
;
6840 /* Initialize the color cache. */
6843 xpm_init_color_cache ()
6845 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
6846 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
6847 memset (xpm_color_cache
, 0, nbytes
);
6848 init_color_table ();
6852 /* Free the color cache. */
6855 xpm_free_color_cache ()
6857 struct xpm_cached_color
*p
, *next
;
6860 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
6861 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
6867 xfree (xpm_color_cache
);
6868 xpm_color_cache
= NULL
;
6869 free_color_table ();
6873 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6874 return the cached definition in *COLOR. Otherwise, make a new
6875 entry in the cache and allocate the color. Value is zero if color
6876 allocation failed. */
6879 xpm_lookup_color (f
, color_name
, color
)
6886 struct xpm_cached_color
*p
;
6888 for (s
= color_name
; *s
; ++s
)
6890 h
%= XPM_COLOR_CACHE_BUCKETS
;
6892 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
6893 if (strcmp (p
->name
, color_name
) == 0)
6898 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
6902 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
6904 nbytes
= sizeof *p
+ strlen (color_name
);
6905 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
6906 strcpy (p
->name
, color_name
);
6908 p
->next
= xpm_color_cache
[h
];
6909 xpm_color_cache
[h
] = p
;
6916 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6917 CLOSURE is a pointer to the frame on which we allocate the
6918 color. Return in *COLOR the allocated color. Value is non-zero
6922 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
6929 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
6933 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
6934 is a pointer to the frame on which we allocate the color. Value is
6935 non-zero if successful. */
6938 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
6948 #endif /* ALLOC_XPM_COLORS */
6951 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6952 for XPM images. Such a list must consist of conses whose car and
6956 xpm_valid_color_symbols_p (color_symbols
)
6957 Lisp_Object color_symbols
;
6959 while (CONSP (color_symbols
))
6961 Lisp_Object sym
= XCAR (color_symbols
);
6963 || !STRINGP (XCAR (sym
))
6964 || !STRINGP (XCDR (sym
)))
6966 color_symbols
= XCDR (color_symbols
);
6969 return NILP (color_symbols
);
6973 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6976 xpm_image_p (object
)
6979 struct image_keyword fmt
[XPM_LAST
];
6980 bcopy (xpm_format
, fmt
, sizeof fmt
);
6981 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6982 /* Either `:file' or `:data' must be present. */
6983 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6984 /* Either no `:color-symbols' or it's a list of conses
6985 whose car and cdr are strings. */
6986 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6987 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
6991 /* Load image IMG which will be displayed on frame F. Value is
6992 non-zero if successful. */
7000 XpmAttributes attrs
;
7001 Lisp_Object specified_file
, color_symbols
;
7003 /* Configure the XPM lib. Use the visual of frame F. Allocate
7004 close colors. Return colors allocated. */
7005 bzero (&attrs
, sizeof attrs
);
7006 attrs
.visual
= FRAME_X_VISUAL (f
);
7007 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7008 attrs
.valuemask
|= XpmVisual
;
7009 attrs
.valuemask
|= XpmColormap
;
7011 #ifdef ALLOC_XPM_COLORS
7012 /* Allocate colors with our own functions which handle
7013 failing color allocation more gracefully. */
7014 attrs
.color_closure
= f
;
7015 attrs
.alloc_color
= xpm_alloc_color
;
7016 attrs
.free_colors
= xpm_free_colors
;
7017 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7018 #else /* not ALLOC_XPM_COLORS */
7019 /* Let the XPM lib allocate colors. */
7020 attrs
.valuemask
|= XpmReturnAllocPixels
;
7021 #ifdef XpmAllocCloseColors
7022 attrs
.alloc_close_colors
= 1;
7023 attrs
.valuemask
|= XpmAllocCloseColors
;
7024 #else /* not XpmAllocCloseColors */
7025 attrs
.closeness
= 600;
7026 attrs
.valuemask
|= XpmCloseness
;
7027 #endif /* not XpmAllocCloseColors */
7028 #endif /* ALLOC_XPM_COLORS */
7030 /* If image specification contains symbolic color definitions, add
7031 these to `attrs'. */
7032 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7033 if (CONSP (color_symbols
))
7036 XpmColorSymbol
*xpm_syms
;
7039 attrs
.valuemask
|= XpmColorSymbols
;
7041 /* Count number of symbols. */
7042 attrs
.numsymbols
= 0;
7043 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7046 /* Allocate an XpmColorSymbol array. */
7047 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7048 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7049 bzero (xpm_syms
, size
);
7050 attrs
.colorsymbols
= xpm_syms
;
7052 /* Fill the color symbol array. */
7053 for (tail
= color_symbols
, i
= 0;
7055 ++i
, tail
= XCDR (tail
))
7057 Lisp_Object name
= XCAR (XCAR (tail
));
7058 Lisp_Object color
= XCDR (XCAR (tail
));
7059 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7060 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7061 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7062 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7066 /* Create a pixmap for the image, either from a file, or from a
7067 string buffer containing data in the same format as an XPM file. */
7068 #ifdef ALLOC_XPM_COLORS
7069 xpm_init_color_cache ();
7072 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7073 if (STRINGP (specified_file
))
7075 Lisp_Object file
= x_find_image_file (specified_file
);
7076 if (!STRINGP (file
))
7078 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7082 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7083 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7088 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7089 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7090 XSTRING (buffer
)->data
,
7091 &img
->pixmap
, &img
->mask
,
7095 if (rc
== XpmSuccess
)
7097 #ifdef ALLOC_XPM_COLORS
7098 img
->colors
= colors_in_color_table (&img
->ncolors
);
7099 #else /* not ALLOC_XPM_COLORS */
7100 img
->ncolors
= attrs
.nalloc_pixels
;
7101 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7102 * sizeof *img
->colors
);
7103 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7105 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7106 #ifdef DEBUG_X_COLORS
7107 register_color (img
->colors
[i
]);
7110 #endif /* not ALLOC_XPM_COLORS */
7112 img
->width
= attrs
.width
;
7113 img
->height
= attrs
.height
;
7114 xassert (img
->width
> 0 && img
->height
> 0);
7116 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7117 XpmFreeAttributes (&attrs
);
7124 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7127 case XpmFileInvalid
:
7128 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7132 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7135 case XpmColorFailed
:
7136 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7140 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7145 #ifdef ALLOC_XPM_COLORS
7146 xpm_free_color_cache ();
7148 return rc
== XpmSuccess
;
7151 #endif /* HAVE_XPM != 0 */
7154 /***********************************************************************
7156 ***********************************************************************/
7158 /* An entry in the color table mapping an RGB color to a pixel color. */
7163 unsigned long pixel
;
7165 /* Next in color table collision list. */
7166 struct ct_color
*next
;
7169 /* The bucket vector size to use. Must be prime. */
7173 /* Value is a hash of the RGB color given by R, G, and B. */
7175 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7177 /* The color hash table. */
7179 struct ct_color
**ct_table
;
7181 /* Number of entries in the color table. */
7183 int ct_colors_allocated
;
7185 /* Initialize the color table. */
7190 int size
= CT_SIZE
* sizeof (*ct_table
);
7191 ct_table
= (struct ct_color
**) xmalloc (size
);
7192 bzero (ct_table
, size
);
7193 ct_colors_allocated
= 0;
7197 /* Free memory associated with the color table. */
7203 struct ct_color
*p
, *next
;
7205 for (i
= 0; i
< CT_SIZE
; ++i
)
7206 for (p
= ct_table
[i
]; p
; p
= next
)
7217 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7218 entry for that color already is in the color table, return the
7219 pixel color of that entry. Otherwise, allocate a new color for R,
7220 G, B, and make an entry in the color table. */
7222 static unsigned long
7223 lookup_rgb_color (f
, r
, g
, b
)
7227 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7228 int i
= hash
% CT_SIZE
;
7231 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7232 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7245 cmap
= FRAME_X_COLORMAP (f
);
7246 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7250 ++ct_colors_allocated
;
7252 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7256 p
->pixel
= color
.pixel
;
7257 p
->next
= ct_table
[i
];
7261 return FRAME_FOREGROUND_PIXEL (f
);
7268 /* Look up pixel color PIXEL which is used on frame F in the color
7269 table. If not already present, allocate it. Value is PIXEL. */
7271 static unsigned long
7272 lookup_pixel_color (f
, pixel
)
7274 unsigned long pixel
;
7276 int i
= pixel
% CT_SIZE
;
7279 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7280 if (p
->pixel
== pixel
)
7289 cmap
= FRAME_X_COLORMAP (f
);
7290 color
.pixel
= pixel
;
7291 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7292 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7296 ++ct_colors_allocated
;
7298 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7303 p
->next
= ct_table
[i
];
7307 return FRAME_FOREGROUND_PIXEL (f
);
7314 /* Value is a vector of all pixel colors contained in the color table,
7315 allocated via xmalloc. Set *N to the number of colors. */
7317 static unsigned long *
7318 colors_in_color_table (n
)
7323 unsigned long *colors
;
7325 if (ct_colors_allocated
== 0)
7332 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7334 *n
= ct_colors_allocated
;
7336 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7337 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7338 colors
[j
++] = p
->pixel
;
7346 /***********************************************************************
7348 ***********************************************************************/
7350 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7351 int, XImage
*, int));
7352 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7353 XColor
*, int, XImage
*, int));
7354 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7355 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7356 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7358 /* Non-zero means draw a cross on images having `:algorithm
7361 int cross_disabled_images
;
7363 /* Edge detection matrices for different edge-detection
7366 static int emboss_matrix
[9] = {
7368 2, -1, 0, /* y - 1 */
7370 0, 1, -2 /* y + 1 */
7373 static int laplace_matrix
[9] = {
7375 1, 0, 0, /* y - 1 */
7377 0, 0, -1 /* y + 1 */
7380 /* Value is the intensity of the color whose red/green/blue values
7383 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7386 /* On frame F, return an array of XColor structures describing image
7387 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7388 non-zero means also fill the red/green/blue members of the XColor
7389 structures. Value is a pointer to the array of XColors structures,
7390 allocated with xmalloc; it must be freed by the caller. */
7393 x_to_xcolors (f
, img
, rgb_p
)
7402 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7404 /* Get the X image IMG->pixmap. */
7405 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7406 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7408 /* Fill the `pixel' members of the XColor array. I wished there
7409 were an easy and portable way to circumvent XGetPixel. */
7411 for (y
= 0; y
< img
->height
; ++y
)
7415 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7416 p
->pixel
= XGetPixel (ximg
, x
, y
);
7419 XQueryColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7423 XDestroyImage (ximg
);
7428 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7429 RGB members are set. F is the frame on which this all happens.
7430 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7433 x_from_xcolors (f
, img
, colors
)
7443 init_color_table ();
7445 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7448 for (y
= 0; y
< img
->height
; ++y
)
7449 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7451 unsigned long pixel
;
7452 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7453 XPutPixel (oimg
, x
, y
, pixel
);
7457 x_clear_image (f
, img
);
7459 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7460 x_destroy_x_image (oimg
);
7461 img
->pixmap
= pixmap
;
7462 img
->colors
= colors_in_color_table (&img
->ncolors
);
7463 free_color_table ();
7467 /* On frame F, perform edge-detection on image IMG.
7469 MATRIX is a nine-element array specifying the transformation
7470 matrix. See emboss_matrix for an example.
7472 COLOR_ADJUST is a color adjustment added to each pixel of the
7476 x_detect_edges (f
, img
, matrix
, color_adjust
)
7479 int matrix
[9], color_adjust
;
7481 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7485 for (i
= sum
= 0; i
< 9; ++i
)
7486 sum
+= abs (matrix
[i
]);
7488 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7490 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7492 for (y
= 0; y
< img
->height
; ++y
)
7494 p
= COLOR (new, 0, y
);
7495 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7496 p
= COLOR (new, img
->width
- 1, y
);
7497 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7500 for (x
= 1; x
< img
->width
- 1; ++x
)
7502 p
= COLOR (new, x
, 0);
7503 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7504 p
= COLOR (new, x
, img
->height
- 1);
7505 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7508 for (y
= 1; y
< img
->height
- 1; ++y
)
7510 p
= COLOR (new, 1, y
);
7512 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7514 int r
, g
, b
, y1
, x1
;
7517 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7518 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7521 XColor
*t
= COLOR (colors
, x1
, y1
);
7522 r
+= matrix
[i
] * t
->red
;
7523 g
+= matrix
[i
] * t
->green
;
7524 b
+= matrix
[i
] * t
->blue
;
7527 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7528 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7529 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7530 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7535 x_from_xcolors (f
, img
, new);
7541 /* Perform the pre-defined `emboss' edge-detection on image IMG
7549 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7553 /* Perform the pre-defined `laplace' edge-detection on image IMG
7561 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7565 /* Perform edge-detection on image IMG on frame F, with specified
7566 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7568 MATRIX must be either
7570 - a list of at least 9 numbers in row-major form
7571 - a vector of at least 9 numbers
7573 COLOR_ADJUST nil means use a default; otherwise it must be a
7577 x_edge_detection (f
, img
, matrix
, color_adjust
)
7580 Lisp_Object matrix
, color_adjust
;
7588 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7589 ++i
, matrix
= XCDR (matrix
))
7590 trans
[i
] = XFLOATINT (XCAR (matrix
));
7592 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7594 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7595 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7598 if (NILP (color_adjust
))
7599 color_adjust
= make_number (0xffff / 2);
7601 if (i
== 9 && NUMBERP (color_adjust
))
7602 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7606 /* Transform image IMG on frame F so that it looks disabled. */
7609 x_disable_image (f
, img
)
7613 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7615 if (dpyinfo
->n_planes
>= 2)
7617 /* Color (or grayscale). Convert to gray, and equalize. Just
7618 drawing such images with a stipple can look very odd, so
7619 we're using this method instead. */
7620 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7622 const int h
= 15000;
7623 const int l
= 30000;
7625 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7629 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7630 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7631 p
->red
= p
->green
= p
->blue
= i2
;
7634 x_from_xcolors (f
, img
, colors
);
7637 /* Draw a cross over the disabled image, if we must or if we
7639 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7641 Display
*dpy
= FRAME_X_DISPLAY (f
);
7644 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7645 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7646 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7647 img
->width
- 1, img
->height
- 1);
7648 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7654 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7655 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7656 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7657 img
->width
- 1, img
->height
- 1);
7658 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7666 /* Build a mask for image IMG which is used on frame F. FILE is the
7667 name of an image file, for error messages. HOW determines how to
7668 determine the background color of IMG. If it is a list '(R G B)',
7669 with R, G, and B being integers >= 0, take that as the color of the
7670 background. Otherwise, determine the background color of IMG
7671 heuristically. Value is non-zero if successful. */
7674 x_build_heuristic_mask (f
, img
, how
)
7679 Display
*dpy
= FRAME_X_DISPLAY (f
);
7680 XImage
*ximg
, *mask_img
;
7681 int x
, y
, rc
, look_at_corners_p
;
7682 unsigned long bg
= 0;
7686 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7690 /* Create an image and pixmap serving as mask. */
7691 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7692 &mask_img
, &img
->mask
);
7696 /* Get the X image of IMG->pixmap. */
7697 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7700 /* Determine the background color of ximg. If HOW is `(R G B)'
7701 take that as color. Otherwise, try to determine the color
7703 look_at_corners_p
= 1;
7711 && NATNUMP (XCAR (how
)))
7713 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7717 if (i
== 3 && NILP (how
))
7719 char color_name
[30];
7720 XColor exact
, color
;
7723 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7725 cmap
= FRAME_X_COLORMAP (f
);
7726 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7729 look_at_corners_p
= 0;
7734 if (look_at_corners_p
)
7736 unsigned long corners
[4];
7739 /* Get the colors at the corners of ximg. */
7740 corners
[0] = XGetPixel (ximg
, 0, 0);
7741 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7742 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7743 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7745 /* Choose the most frequently found color as background. */
7746 for (i
= best_count
= 0; i
< 4; ++i
)
7750 for (j
= n
= 0; j
< 4; ++j
)
7751 if (corners
[i
] == corners
[j
])
7755 bg
= corners
[i
], best_count
= n
;
7759 /* Set all bits in mask_img to 1 whose color in ximg is different
7760 from the background color bg. */
7761 for (y
= 0; y
< img
->height
; ++y
)
7762 for (x
= 0; x
< img
->width
; ++x
)
7763 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7765 /* Put mask_img into img->mask. */
7766 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7767 x_destroy_x_image (mask_img
);
7768 XDestroyImage (ximg
);
7775 /***********************************************************************
7776 PBM (mono, gray, color)
7777 ***********************************************************************/
7779 static int pbm_image_p
P_ ((Lisp_Object object
));
7780 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7781 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7783 /* The symbol `pbm' identifying images of this type. */
7787 /* Indices of image specification fields in gs_format, below. */
7789 enum pbm_keyword_index
7803 /* Vector of image_keyword structures describing the format
7804 of valid user-defined image specifications. */
7806 static struct image_keyword pbm_format
[PBM_LAST
] =
7808 {":type", IMAGE_SYMBOL_VALUE
, 1},
7809 {":file", IMAGE_STRING_VALUE
, 0},
7810 {":data", IMAGE_STRING_VALUE
, 0},
7811 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7812 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7813 {":relief", IMAGE_INTEGER_VALUE
, 0},
7814 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7815 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7816 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7819 /* Structure describing the image type `pbm'. */
7821 static struct image_type pbm_type
=
7831 /* Return non-zero if OBJECT is a valid PBM image specification. */
7834 pbm_image_p (object
)
7837 struct image_keyword fmt
[PBM_LAST
];
7839 bcopy (pbm_format
, fmt
, sizeof fmt
);
7841 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7844 /* Must specify either :data or :file. */
7845 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7849 /* Scan a decimal number from *S and return it. Advance *S while
7850 reading the number. END is the end of the string. Value is -1 at
7854 pbm_scan_number (s
, end
)
7855 unsigned char **s
, *end
;
7857 int c
= 0, val
= -1;
7861 /* Skip white-space. */
7862 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7867 /* Skip comment to end of line. */
7868 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7871 else if (isdigit (c
))
7873 /* Read decimal number. */
7875 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7876 val
= 10 * val
+ c
- '0';
7887 /* Load PBM image IMG for use on frame F. */
7895 int width
, height
, max_color_idx
= 0;
7897 Lisp_Object file
, specified_file
;
7898 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7899 struct gcpro gcpro1
;
7900 unsigned char *contents
= NULL
;
7901 unsigned char *end
, *p
;
7904 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7908 if (STRINGP (specified_file
))
7910 file
= x_find_image_file (specified_file
);
7911 if (!STRINGP (file
))
7913 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7918 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7919 if (contents
== NULL
)
7921 image_error ("Error reading `%s'", file
, Qnil
);
7927 end
= contents
+ size
;
7932 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7933 p
= XSTRING (data
)->data
;
7934 end
= p
+ STRING_BYTES (XSTRING (data
));
7937 /* Check magic number. */
7938 if (end
- p
< 2 || *p
++ != 'P')
7940 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7950 raw_p
= 0, type
= PBM_MONO
;
7954 raw_p
= 0, type
= PBM_GRAY
;
7958 raw_p
= 0, type
= PBM_COLOR
;
7962 raw_p
= 1, type
= PBM_MONO
;
7966 raw_p
= 1, type
= PBM_GRAY
;
7970 raw_p
= 1, type
= PBM_COLOR
;
7974 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7978 /* Read width, height, maximum color-component. Characters
7979 starting with `#' up to the end of a line are ignored. */
7980 width
= pbm_scan_number (&p
, end
);
7981 height
= pbm_scan_number (&p
, end
);
7983 if (type
!= PBM_MONO
)
7985 max_color_idx
= pbm_scan_number (&p
, end
);
7986 if (raw_p
&& max_color_idx
> 255)
7987 max_color_idx
= 255;
7992 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7995 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7996 &ximg
, &img
->pixmap
))
7999 /* Initialize the color hash table. */
8000 init_color_table ();
8002 if (type
== PBM_MONO
)
8006 for (y
= 0; y
< height
; ++y
)
8007 for (x
= 0; x
< width
; ++x
)
8017 g
= pbm_scan_number (&p
, end
);
8019 XPutPixel (ximg
, x
, y
, (g
8020 ? FRAME_FOREGROUND_PIXEL (f
)
8021 : FRAME_BACKGROUND_PIXEL (f
)));
8026 for (y
= 0; y
< height
; ++y
)
8027 for (x
= 0; x
< width
; ++x
)
8031 if (type
== PBM_GRAY
)
8032 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8041 r
= pbm_scan_number (&p
, end
);
8042 g
= pbm_scan_number (&p
, end
);
8043 b
= pbm_scan_number (&p
, end
);
8046 if (r
< 0 || g
< 0 || b
< 0)
8050 XDestroyImage (ximg
);
8051 image_error ("Invalid pixel value in image `%s'",
8056 /* RGB values are now in the range 0..max_color_idx.
8057 Scale this to the range 0..0xffff supported by X. */
8058 r
= (double) r
* 65535 / max_color_idx
;
8059 g
= (double) g
* 65535 / max_color_idx
;
8060 b
= (double) b
* 65535 / max_color_idx
;
8061 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8065 /* Store in IMG->colors the colors allocated for the image, and
8066 free the color table. */
8067 img
->colors
= colors_in_color_table (&img
->ncolors
);
8068 free_color_table ();
8070 /* Put the image into a pixmap. */
8071 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8072 x_destroy_x_image (ximg
);
8075 img
->height
= height
;
8084 /***********************************************************************
8086 ***********************************************************************/
8092 /* Function prototypes. */
8094 static int png_image_p
P_ ((Lisp_Object object
));
8095 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8097 /* The symbol `png' identifying images of this type. */
8101 /* Indices of image specification fields in png_format, below. */
8103 enum png_keyword_index
8117 /* Vector of image_keyword structures describing the format
8118 of valid user-defined image specifications. */
8120 static struct image_keyword png_format
[PNG_LAST
] =
8122 {":type", IMAGE_SYMBOL_VALUE
, 1},
8123 {":data", IMAGE_STRING_VALUE
, 0},
8124 {":file", IMAGE_STRING_VALUE
, 0},
8125 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8126 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8127 {":relief", IMAGE_INTEGER_VALUE
, 0},
8128 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8129 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8130 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8133 /* Structure describing the image type `png'. */
8135 static struct image_type png_type
=
8145 /* Return non-zero if OBJECT is a valid PNG image specification. */
8148 png_image_p (object
)
8151 struct image_keyword fmt
[PNG_LAST
];
8152 bcopy (png_format
, fmt
, sizeof fmt
);
8154 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8157 /* Must specify either the :data or :file keyword. */
8158 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8162 /* Error and warning handlers installed when the PNG library
8166 my_png_error (png_ptr
, msg
)
8167 png_struct
*png_ptr
;
8170 xassert (png_ptr
!= NULL
);
8171 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8172 longjmp (png_ptr
->jmpbuf
, 1);
8177 my_png_warning (png_ptr
, msg
)
8178 png_struct
*png_ptr
;
8181 xassert (png_ptr
!= NULL
);
8182 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8185 /* Memory source for PNG decoding. */
8187 struct png_memory_storage
8189 unsigned char *bytes
; /* The data */
8190 size_t len
; /* How big is it? */
8191 int index
; /* Where are we? */
8195 /* Function set as reader function when reading PNG image from memory.
8196 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8197 bytes from the input to DATA. */
8200 png_read_from_memory (png_ptr
, data
, length
)
8201 png_structp png_ptr
;
8205 struct png_memory_storage
*tbr
8206 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8208 if (length
> tbr
->len
- tbr
->index
)
8209 png_error (png_ptr
, "Read error");
8211 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8212 tbr
->index
= tbr
->index
+ length
;
8215 /* Load PNG image IMG for use on frame F. Value is non-zero if
8223 Lisp_Object file
, specified_file
;
8224 Lisp_Object specified_data
;
8226 XImage
*ximg
, *mask_img
= NULL
;
8227 struct gcpro gcpro1
;
8228 png_struct
*png_ptr
= NULL
;
8229 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8230 FILE *volatile fp
= NULL
;
8232 png_byte
* volatile pixels
= NULL
;
8233 png_byte
** volatile rows
= NULL
;
8234 png_uint_32 width
, height
;
8235 int bit_depth
, color_type
, interlace_type
;
8237 png_uint_32 row_bytes
;
8240 double screen_gamma
, image_gamma
;
8242 struct png_memory_storage tbr
; /* Data to be read */
8244 /* Find out what file to load. */
8245 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8246 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8250 if (NILP (specified_data
))
8252 file
= x_find_image_file (specified_file
);
8253 if (!STRINGP (file
))
8255 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8260 /* Open the image file. */
8261 fp
= fopen (XSTRING (file
)->data
, "rb");
8264 image_error ("Cannot open image file `%s'", file
, Qnil
);
8270 /* Check PNG signature. */
8271 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8272 || !png_check_sig (sig
, sizeof sig
))
8274 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8282 /* Read from memory. */
8283 tbr
.bytes
= XSTRING (specified_data
)->data
;
8284 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8287 /* Check PNG signature. */
8288 if (tbr
.len
< sizeof sig
8289 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8291 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8296 /* Need to skip past the signature. */
8297 tbr
.bytes
+= sizeof (sig
);
8300 /* Initialize read and info structs for PNG lib. */
8301 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8302 my_png_error
, my_png_warning
);
8305 if (fp
) fclose (fp
);
8310 info_ptr
= png_create_info_struct (png_ptr
);
8313 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8314 if (fp
) fclose (fp
);
8319 end_info
= png_create_info_struct (png_ptr
);
8322 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8323 if (fp
) fclose (fp
);
8328 /* Set error jump-back. We come back here when the PNG library
8329 detects an error. */
8330 if (setjmp (png_ptr
->jmpbuf
))
8334 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8337 if (fp
) fclose (fp
);
8342 /* Read image info. */
8343 if (!NILP (specified_data
))
8344 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8346 png_init_io (png_ptr
, fp
);
8348 png_set_sig_bytes (png_ptr
, sizeof sig
);
8349 png_read_info (png_ptr
, info_ptr
);
8350 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8351 &interlace_type
, NULL
, NULL
);
8353 /* If image contains simply transparency data, we prefer to
8354 construct a clipping mask. */
8355 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8360 /* This function is easier to write if we only have to handle
8361 one data format: RGB or RGBA with 8 bits per channel. Let's
8362 transform other formats into that format. */
8364 /* Strip more than 8 bits per channel. */
8365 if (bit_depth
== 16)
8366 png_set_strip_16 (png_ptr
);
8368 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8370 png_set_expand (png_ptr
);
8372 /* Convert grayscale images to RGB. */
8373 if (color_type
== PNG_COLOR_TYPE_GRAY
8374 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8375 png_set_gray_to_rgb (png_ptr
);
8377 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8378 gamma_str
= getenv ("SCREEN_GAMMA");
8379 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8381 /* Tell the PNG lib to handle gamma correction for us. */
8383 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8384 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8385 /* There is a special chunk in the image specifying the gamma. */
8386 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8389 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8390 /* Image contains gamma information. */
8391 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8393 /* Use a default of 0.5 for the image gamma. */
8394 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8396 /* Handle alpha channel by combining the image with a background
8397 color. Do this only if a real alpha channel is supplied. For
8398 simple transparency, we prefer a clipping mask. */
8401 png_color_16
*image_background
;
8403 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8404 /* Image contains a background color with which to
8405 combine the image. */
8406 png_set_background (png_ptr
, image_background
,
8407 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8410 /* Image does not contain a background color with which
8411 to combine the image data via an alpha channel. Use
8412 the frame's background instead. */
8415 png_color_16 frame_background
;
8417 cmap
= FRAME_X_COLORMAP (f
);
8418 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8419 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8421 bzero (&frame_background
, sizeof frame_background
);
8422 frame_background
.red
= color
.red
;
8423 frame_background
.green
= color
.green
;
8424 frame_background
.blue
= color
.blue
;
8426 png_set_background (png_ptr
, &frame_background
,
8427 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8431 /* Update info structure. */
8432 png_read_update_info (png_ptr
, info_ptr
);
8434 /* Get number of channels. Valid values are 1 for grayscale images
8435 and images with a palette, 2 for grayscale images with transparency
8436 information (alpha channel), 3 for RGB images, and 4 for RGB
8437 images with alpha channel, i.e. RGBA. If conversions above were
8438 sufficient we should only have 3 or 4 channels here. */
8439 channels
= png_get_channels (png_ptr
, info_ptr
);
8440 xassert (channels
== 3 || channels
== 4);
8442 /* Number of bytes needed for one row of the image. */
8443 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8445 /* Allocate memory for the image. */
8446 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8447 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8448 for (i
= 0; i
< height
; ++i
)
8449 rows
[i
] = pixels
+ i
* row_bytes
;
8451 /* Read the entire image. */
8452 png_read_image (png_ptr
, rows
);
8453 png_read_end (png_ptr
, info_ptr
);
8460 /* Create the X image and pixmap. */
8461 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8465 /* Create an image and pixmap serving as mask if the PNG image
8466 contains an alpha channel. */
8469 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8470 &mask_img
, &img
->mask
))
8472 x_destroy_x_image (ximg
);
8473 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8478 /* Fill the X image and mask from PNG data. */
8479 init_color_table ();
8481 for (y
= 0; y
< height
; ++y
)
8483 png_byte
*p
= rows
[y
];
8485 for (x
= 0; x
< width
; ++x
)
8492 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8494 /* An alpha channel, aka mask channel, associates variable
8495 transparency with an image. Where other image formats
8496 support binary transparency---fully transparent or fully
8497 opaque---PNG allows up to 254 levels of partial transparency.
8498 The PNG library implements partial transparency by combining
8499 the image with a specified background color.
8501 I'm not sure how to handle this here nicely: because the
8502 background on which the image is displayed may change, for
8503 real alpha channel support, it would be necessary to create
8504 a new image for each possible background.
8506 What I'm doing now is that a mask is created if we have
8507 boolean transparency information. Otherwise I'm using
8508 the frame's background color to combine the image with. */
8513 XPutPixel (mask_img
, x
, y
, *p
> 0);
8519 /* Remember colors allocated for this image. */
8520 img
->colors
= colors_in_color_table (&img
->ncolors
);
8521 free_color_table ();
8524 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8529 img
->height
= height
;
8531 /* Put the image into the pixmap, then free the X image and its buffer. */
8532 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8533 x_destroy_x_image (ximg
);
8535 /* Same for the mask. */
8538 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8539 x_destroy_x_image (mask_img
);
8546 #endif /* HAVE_PNG != 0 */
8550 /***********************************************************************
8552 ***********************************************************************/
8556 /* Work around a warning about HAVE_STDLIB_H being redefined in
8558 #ifdef HAVE_STDLIB_H
8559 #define HAVE_STDLIB_H_1
8560 #undef HAVE_STDLIB_H
8561 #endif /* HAVE_STLIB_H */
8563 #include <jpeglib.h>
8567 #ifdef HAVE_STLIB_H_1
8568 #define HAVE_STDLIB_H 1
8571 static int jpeg_image_p
P_ ((Lisp_Object object
));
8572 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8574 /* The symbol `jpeg' identifying images of this type. */
8578 /* Indices of image specification fields in gs_format, below. */
8580 enum jpeg_keyword_index
8589 JPEG_HEURISTIC_MASK
,
8594 /* Vector of image_keyword structures describing the format
8595 of valid user-defined image specifications. */
8597 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8599 {":type", IMAGE_SYMBOL_VALUE
, 1},
8600 {":data", IMAGE_STRING_VALUE
, 0},
8601 {":file", IMAGE_STRING_VALUE
, 0},
8602 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8603 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8604 {":relief", IMAGE_INTEGER_VALUE
, 0},
8605 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8606 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8607 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8610 /* Structure describing the image type `jpeg'. */
8612 static struct image_type jpeg_type
=
8622 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8625 jpeg_image_p (object
)
8628 struct image_keyword fmt
[JPEG_LAST
];
8630 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8632 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8635 /* Must specify either the :data or :file keyword. */
8636 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8640 struct my_jpeg_error_mgr
8642 struct jpeg_error_mgr pub
;
8643 jmp_buf setjmp_buffer
;
8648 my_error_exit (cinfo
)
8651 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8652 longjmp (mgr
->setjmp_buffer
, 1);
8656 /* Init source method for JPEG data source manager. Called by
8657 jpeg_read_header() before any data is actually read. See
8658 libjpeg.doc from the JPEG lib distribution. */
8661 our_init_source (cinfo
)
8662 j_decompress_ptr cinfo
;
8667 /* Fill input buffer method for JPEG data source manager. Called
8668 whenever more data is needed. We read the whole image in one step,
8669 so this only adds a fake end of input marker at the end. */
8672 our_fill_input_buffer (cinfo
)
8673 j_decompress_ptr cinfo
;
8675 /* Insert a fake EOI marker. */
8676 struct jpeg_source_mgr
*src
= cinfo
->src
;
8677 static JOCTET buffer
[2];
8679 buffer
[0] = (JOCTET
) 0xFF;
8680 buffer
[1] = (JOCTET
) JPEG_EOI
;
8682 src
->next_input_byte
= buffer
;
8683 src
->bytes_in_buffer
= 2;
8688 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8689 is the JPEG data source manager. */
8692 our_skip_input_data (cinfo
, num_bytes
)
8693 j_decompress_ptr cinfo
;
8696 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8700 if (num_bytes
> src
->bytes_in_buffer
)
8701 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8703 src
->bytes_in_buffer
-= num_bytes
;
8704 src
->next_input_byte
+= num_bytes
;
8709 /* Method to terminate data source. Called by
8710 jpeg_finish_decompress() after all data has been processed. */
8713 our_term_source (cinfo
)
8714 j_decompress_ptr cinfo
;
8719 /* Set up the JPEG lib for reading an image from DATA which contains
8720 LEN bytes. CINFO is the decompression info structure created for
8721 reading the image. */
8724 jpeg_memory_src (cinfo
, data
, len
)
8725 j_decompress_ptr cinfo
;
8729 struct jpeg_source_mgr
*src
;
8731 if (cinfo
->src
== NULL
)
8733 /* First time for this JPEG object? */
8734 cinfo
->src
= (struct jpeg_source_mgr
*)
8735 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8736 sizeof (struct jpeg_source_mgr
));
8737 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8738 src
->next_input_byte
= data
;
8741 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8742 src
->init_source
= our_init_source
;
8743 src
->fill_input_buffer
= our_fill_input_buffer
;
8744 src
->skip_input_data
= our_skip_input_data
;
8745 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8746 src
->term_source
= our_term_source
;
8747 src
->bytes_in_buffer
= len
;
8748 src
->next_input_byte
= data
;
8752 /* Load image IMG for use on frame F. Patterned after example.c
8753 from the JPEG lib. */
8760 struct jpeg_decompress_struct cinfo
;
8761 struct my_jpeg_error_mgr mgr
;
8762 Lisp_Object file
, specified_file
;
8763 Lisp_Object specified_data
;
8764 FILE * volatile fp
= NULL
;
8766 int row_stride
, x
, y
;
8767 XImage
*ximg
= NULL
;
8769 unsigned long *colors
;
8771 struct gcpro gcpro1
;
8773 /* Open the JPEG file. */
8774 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8775 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8779 if (NILP (specified_data
))
8781 file
= x_find_image_file (specified_file
);
8782 if (!STRINGP (file
))
8784 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8789 fp
= fopen (XSTRING (file
)->data
, "r");
8792 image_error ("Cannot open `%s'", file
, Qnil
);
8798 /* Customize libjpeg's error handling to call my_error_exit when an
8799 error is detected. This function will perform a longjmp. */
8800 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8801 mgr
.pub
.error_exit
= my_error_exit
;
8803 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8807 /* Called from my_error_exit. Display a JPEG error. */
8808 char buffer
[JMSG_LENGTH_MAX
];
8809 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8810 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8811 build_string (buffer
));
8814 /* Close the input file and destroy the JPEG object. */
8816 fclose ((FILE *) fp
);
8817 jpeg_destroy_decompress (&cinfo
);
8819 /* If we already have an XImage, free that. */
8820 x_destroy_x_image (ximg
);
8822 /* Free pixmap and colors. */
8823 x_clear_image (f
, img
);
8829 /* Create the JPEG decompression object. Let it read from fp.
8830 Read the JPEG image header. */
8831 jpeg_create_decompress (&cinfo
);
8833 if (NILP (specified_data
))
8834 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
8836 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8837 STRING_BYTES (XSTRING (specified_data
)));
8839 jpeg_read_header (&cinfo
, TRUE
);
8841 /* Customize decompression so that color quantization will be used.
8842 Start decompression. */
8843 cinfo
.quantize_colors
= TRUE
;
8844 jpeg_start_decompress (&cinfo
);
8845 width
= img
->width
= cinfo
.output_width
;
8846 height
= img
->height
= cinfo
.output_height
;
8848 /* Create X image and pixmap. */
8849 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8850 longjmp (mgr
.setjmp_buffer
, 2);
8852 /* Allocate colors. When color quantization is used,
8853 cinfo.actual_number_of_colors has been set with the number of
8854 colors generated, and cinfo.colormap is a two-dimensional array
8855 of color indices in the range 0..cinfo.actual_number_of_colors.
8856 No more than 255 colors will be generated. */
8860 if (cinfo
.out_color_components
> 2)
8861 ir
= 0, ig
= 1, ib
= 2;
8862 else if (cinfo
.out_color_components
> 1)
8863 ir
= 0, ig
= 1, ib
= 0;
8865 ir
= 0, ig
= 0, ib
= 0;
8867 /* Use the color table mechanism because it handles colors that
8868 cannot be allocated nicely. Such colors will be replaced with
8869 a default color, and we don't have to care about which colors
8870 can be freed safely, and which can't. */
8871 init_color_table ();
8872 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8875 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8877 /* Multiply RGB values with 255 because X expects RGB values
8878 in the range 0..0xffff. */
8879 int r
= cinfo
.colormap
[ir
][i
] << 8;
8880 int g
= cinfo
.colormap
[ig
][i
] << 8;
8881 int b
= cinfo
.colormap
[ib
][i
] << 8;
8882 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8885 /* Remember those colors actually allocated. */
8886 img
->colors
= colors_in_color_table (&img
->ncolors
);
8887 free_color_table ();
8891 row_stride
= width
* cinfo
.output_components
;
8892 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8894 for (y
= 0; y
< height
; ++y
)
8896 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8897 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8898 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8902 jpeg_finish_decompress (&cinfo
);
8903 jpeg_destroy_decompress (&cinfo
);
8905 fclose ((FILE *) fp
);
8907 /* Put the image into the pixmap. */
8908 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8909 x_destroy_x_image (ximg
);
8914 #endif /* HAVE_JPEG */
8918 /***********************************************************************
8920 ***********************************************************************/
8926 static int tiff_image_p
P_ ((Lisp_Object object
));
8927 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8929 /* The symbol `tiff' identifying images of this type. */
8933 /* Indices of image specification fields in tiff_format, below. */
8935 enum tiff_keyword_index
8944 TIFF_HEURISTIC_MASK
,
8949 /* Vector of image_keyword structures describing the format
8950 of valid user-defined image specifications. */
8952 static struct image_keyword tiff_format
[TIFF_LAST
] =
8954 {":type", IMAGE_SYMBOL_VALUE
, 1},
8955 {":data", IMAGE_STRING_VALUE
, 0},
8956 {":file", IMAGE_STRING_VALUE
, 0},
8957 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8958 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8959 {":relief", IMAGE_INTEGER_VALUE
, 0},
8960 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8961 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8962 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8965 /* Structure describing the image type `tiff'. */
8967 static struct image_type tiff_type
=
8977 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8980 tiff_image_p (object
)
8983 struct image_keyword fmt
[TIFF_LAST
];
8984 bcopy (tiff_format
, fmt
, sizeof fmt
);
8986 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
8989 /* Must specify either the :data or :file keyword. */
8990 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8994 /* Reading from a memory buffer for TIFF images Based on the PNG
8995 memory source, but we have to provide a lot of extra functions.
8998 We really only need to implement read and seek, but I am not
8999 convinced that the TIFF library is smart enough not to destroy
9000 itself if we only hand it the function pointers we need to
9005 unsigned char *bytes
;
9013 tiff_read_from_memory (data
, buf
, size
)
9018 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9020 if (size
> src
->len
- src
->index
)
9022 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9029 tiff_write_from_memory (data
, buf
, size
)
9039 tiff_seek_in_memory (data
, off
, whence
)
9044 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9049 case SEEK_SET
: /* Go from beginning of source. */
9053 case SEEK_END
: /* Go from end of source. */
9054 idx
= src
->len
+ off
;
9057 case SEEK_CUR
: /* Go from current position. */
9058 idx
= src
->index
+ off
;
9061 default: /* Invalid `whence'. */
9065 if (idx
> src
->len
|| idx
< 0)
9074 tiff_close_memory (data
)
9083 tiff_mmap_memory (data
, pbase
, psize
)
9088 /* It is already _IN_ memory. */
9094 tiff_unmap_memory (data
, base
, size
)
9099 /* We don't need to do this. */
9104 tiff_size_of_memory (data
)
9107 return ((tiff_memory_source
*) data
)->len
;
9111 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9119 Lisp_Object file
, specified_file
;
9120 Lisp_Object specified_data
;
9122 int width
, height
, x
, y
;
9126 struct gcpro gcpro1
;
9127 tiff_memory_source memsrc
;
9129 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9130 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9134 if (NILP (specified_data
))
9136 /* Read from a file */
9137 file
= x_find_image_file (specified_file
);
9138 if (!STRINGP (file
))
9140 image_error ("Cannot find image file `%s'", file
, Qnil
);
9145 /* Try to open the image file. */
9146 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9149 image_error ("Cannot open `%s'", file
, Qnil
);
9156 /* Memory source! */
9157 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9158 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9161 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9162 (TIFFReadWriteProc
) tiff_read_from_memory
,
9163 (TIFFReadWriteProc
) tiff_write_from_memory
,
9164 tiff_seek_in_memory
,
9166 tiff_size_of_memory
,
9172 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9178 /* Get width and height of the image, and allocate a raster buffer
9179 of width x height 32-bit values. */
9180 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9181 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9182 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9184 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9188 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9194 /* Create the X image and pixmap. */
9195 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9202 /* Initialize the color table. */
9203 init_color_table ();
9205 /* Process the pixel raster. Origin is in the lower-left corner. */
9206 for (y
= 0; y
< height
; ++y
)
9208 uint32
*row
= buf
+ y
* width
;
9210 for (x
= 0; x
< width
; ++x
)
9212 uint32 abgr
= row
[x
];
9213 int r
= TIFFGetR (abgr
) << 8;
9214 int g
= TIFFGetG (abgr
) << 8;
9215 int b
= TIFFGetB (abgr
) << 8;
9216 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9220 /* Remember the colors allocated for the image. Free the color table. */
9221 img
->colors
= colors_in_color_table (&img
->ncolors
);
9222 free_color_table ();
9224 /* Put the image into the pixmap, then free the X image and its buffer. */
9225 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9226 x_destroy_x_image (ximg
);
9230 img
->height
= height
;
9236 #endif /* HAVE_TIFF != 0 */
9240 /***********************************************************************
9242 ***********************************************************************/
9246 #include <gif_lib.h>
9248 static int gif_image_p
P_ ((Lisp_Object object
));
9249 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9251 /* The symbol `gif' identifying images of this type. */
9255 /* Indices of image specification fields in gif_format, below. */
9257 enum gif_keyword_index
9272 /* Vector of image_keyword structures describing the format
9273 of valid user-defined image specifications. */
9275 static struct image_keyword gif_format
[GIF_LAST
] =
9277 {":type", IMAGE_SYMBOL_VALUE
, 1},
9278 {":data", IMAGE_STRING_VALUE
, 0},
9279 {":file", IMAGE_STRING_VALUE
, 0},
9280 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9281 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9282 {":relief", IMAGE_INTEGER_VALUE
, 0},
9283 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9284 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9285 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9286 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9289 /* Structure describing the image type `gif'. */
9291 static struct image_type gif_type
=
9301 /* Return non-zero if OBJECT is a valid GIF image specification. */
9304 gif_image_p (object
)
9307 struct image_keyword fmt
[GIF_LAST
];
9308 bcopy (gif_format
, fmt
, sizeof fmt
);
9310 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9313 /* Must specify either the :data or :file keyword. */
9314 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9318 /* Reading a GIF image from memory
9319 Based on the PNG memory stuff to a certain extent. */
9323 unsigned char *bytes
;
9330 /* Make the current memory source available to gif_read_from_memory.
9331 It's done this way because not all versions of libungif support
9332 a UserData field in the GifFileType structure. */
9333 static gif_memory_source
*current_gif_memory_src
;
9336 gif_read_from_memory (file
, buf
, len
)
9341 gif_memory_source
*src
= current_gif_memory_src
;
9343 if (len
> src
->len
- src
->index
)
9346 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9352 /* Load GIF image IMG for use on frame F. Value is non-zero if
9360 Lisp_Object file
, specified_file
;
9361 Lisp_Object specified_data
;
9362 int rc
, width
, height
, x
, y
, i
;
9364 ColorMapObject
*gif_color_map
;
9365 unsigned long pixel_colors
[256];
9367 struct gcpro gcpro1
;
9369 int ino
, image_left
, image_top
, image_width
, image_height
;
9370 gif_memory_source memsrc
;
9371 unsigned char *raster
;
9373 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9374 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9378 if (NILP (specified_data
))
9380 file
= x_find_image_file (specified_file
);
9381 if (!STRINGP (file
))
9383 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9388 /* Open the GIF file. */
9389 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9392 image_error ("Cannot open `%s'", file
, Qnil
);
9399 /* Read from memory! */
9400 current_gif_memory_src
= &memsrc
;
9401 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9402 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9405 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9408 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9414 /* Read entire contents. */
9415 rc
= DGifSlurp (gif
);
9416 if (rc
== GIF_ERROR
)
9418 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9419 DGifCloseFile (gif
);
9424 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9425 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9426 if (ino
>= gif
->ImageCount
)
9428 image_error ("Invalid image number `%s' in image `%s'",
9430 DGifCloseFile (gif
);
9435 width
= img
->width
= gif
->SWidth
;
9436 height
= img
->height
= gif
->SHeight
;
9438 /* Create the X image and pixmap. */
9439 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9441 DGifCloseFile (gif
);
9446 /* Allocate colors. */
9447 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9449 gif_color_map
= gif
->SColorMap
;
9450 init_color_table ();
9451 bzero (pixel_colors
, sizeof pixel_colors
);
9453 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9455 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9456 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9457 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9458 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9461 img
->colors
= colors_in_color_table (&img
->ncolors
);
9462 free_color_table ();
9464 /* Clear the part of the screen image that are not covered by
9465 the image from the GIF file. Full animated GIF support
9466 requires more than can be done here (see the gif89 spec,
9467 disposal methods). Let's simply assume that the part
9468 not covered by a sub-image is in the frame's background color. */
9469 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9470 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9471 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9472 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9474 for (y
= 0; y
< image_top
; ++y
)
9475 for (x
= 0; x
< width
; ++x
)
9476 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9478 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9479 for (x
= 0; x
< width
; ++x
)
9480 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9482 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9484 for (x
= 0; x
< image_left
; ++x
)
9485 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9486 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9487 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9490 /* Read the GIF image into the X image. We use a local variable
9491 `raster' here because RasterBits below is a char *, and invites
9492 problems with bytes >= 0x80. */
9493 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9495 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9497 static int interlace_start
[] = {0, 4, 2, 1};
9498 static int interlace_increment
[] = {8, 8, 4, 2};
9500 int row
= interlace_start
[0];
9504 for (y
= 0; y
< image_height
; y
++)
9506 if (row
>= image_height
)
9508 row
= interlace_start
[++pass
];
9509 while (row
>= image_height
)
9510 row
= interlace_start
[++pass
];
9513 for (x
= 0; x
< image_width
; x
++)
9515 int i
= raster
[(y
* image_width
) + x
];
9516 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9520 row
+= interlace_increment
[pass
];
9525 for (y
= 0; y
< image_height
; ++y
)
9526 for (x
= 0; x
< image_width
; ++x
)
9528 int i
= raster
[y
* image_width
+ x
];
9529 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9533 DGifCloseFile (gif
);
9535 /* Put the image into the pixmap, then free the X image and its buffer. */
9536 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9537 x_destroy_x_image (ximg
);
9543 #endif /* HAVE_GIF != 0 */
9547 /***********************************************************************
9549 ***********************************************************************/
9551 static int gs_image_p
P_ ((Lisp_Object object
));
9552 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9553 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9555 /* The symbol `postscript' identifying images of this type. */
9557 Lisp_Object Qpostscript
;
9559 /* Keyword symbols. */
9561 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9563 /* Indices of image specification fields in gs_format, below. */
9565 enum gs_keyword_index
9582 /* Vector of image_keyword structures describing the format
9583 of valid user-defined image specifications. */
9585 static struct image_keyword gs_format
[GS_LAST
] =
9587 {":type", IMAGE_SYMBOL_VALUE
, 1},
9588 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9589 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9590 {":file", IMAGE_STRING_VALUE
, 1},
9591 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9592 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9593 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9594 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9595 {":relief", IMAGE_INTEGER_VALUE
, 0},
9596 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9597 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9598 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9601 /* Structure describing the image type `ghostscript'. */
9603 static struct image_type gs_type
=
9613 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9616 gs_clear_image (f
, img
)
9620 /* IMG->data.ptr_val may contain a recorded colormap. */
9621 xfree (img
->data
.ptr_val
);
9622 x_clear_image (f
, img
);
9626 /* Return non-zero if OBJECT is a valid Ghostscript image
9633 struct image_keyword fmt
[GS_LAST
];
9637 bcopy (gs_format
, fmt
, sizeof fmt
);
9639 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9642 /* Bounding box must be a list or vector containing 4 integers. */
9643 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9646 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9647 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9652 else if (VECTORP (tem
))
9654 if (XVECTOR (tem
)->size
!= 4)
9656 for (i
= 0; i
< 4; ++i
)
9657 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9667 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9676 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9677 struct gcpro gcpro1
, gcpro2
;
9679 double in_width
, in_height
;
9680 Lisp_Object pixel_colors
= Qnil
;
9682 /* Compute pixel size of pixmap needed from the given size in the
9683 image specification. Sizes in the specification are in pt. 1 pt
9684 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9686 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9687 in_width
= XFASTINT (pt_width
) / 72.0;
9688 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9689 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9690 in_height
= XFASTINT (pt_height
) / 72.0;
9691 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9693 /* Create the pixmap. */
9694 xassert (img
->pixmap
== 0);
9695 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9696 img
->width
, img
->height
,
9697 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9701 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9705 /* Call the loader to fill the pixmap. It returns a process object
9706 if successful. We do not record_unwind_protect here because
9707 other places in redisplay like calling window scroll functions
9708 don't either. Let the Lisp loader use `unwind-protect' instead. */
9709 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9711 sprintf (buffer
, "%lu %lu",
9712 (unsigned long) FRAME_X_WINDOW (f
),
9713 (unsigned long) img
->pixmap
);
9714 window_and_pixmap_id
= build_string (buffer
);
9716 sprintf (buffer
, "%lu %lu",
9717 FRAME_FOREGROUND_PIXEL (f
),
9718 FRAME_BACKGROUND_PIXEL (f
));
9719 pixel_colors
= build_string (buffer
);
9721 XSETFRAME (frame
, f
);
9722 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9724 loader
= intern ("gs-load-image");
9726 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9727 make_number (img
->width
),
9728 make_number (img
->height
),
9729 window_and_pixmap_id
,
9732 return PROCESSP (img
->data
.lisp_val
);
9736 /* Kill the Ghostscript process that was started to fill PIXMAP on
9737 frame F. Called from XTread_socket when receiving an event
9738 telling Emacs that Ghostscript has finished drawing. */
9741 x_kill_gs_process (pixmap
, f
)
9745 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9749 /* Find the image containing PIXMAP. */
9750 for (i
= 0; i
< c
->used
; ++i
)
9751 if (c
->images
[i
]->pixmap
== pixmap
)
9754 /* Kill the GS process. We should have found PIXMAP in the image
9755 cache and its image should contain a process object. */
9756 xassert (i
< c
->used
);
9758 xassert (PROCESSP (img
->data
.lisp_val
));
9759 Fkill_process (img
->data
.lisp_val
, Qnil
);
9760 img
->data
.lisp_val
= Qnil
;
9762 /* On displays with a mutable colormap, figure out the colors
9763 allocated for the image by looking at the pixels of an XImage for
9765 class = FRAME_X_VISUAL (f
)->class;
9766 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9772 /* Try to get an XImage for img->pixmep. */
9773 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9774 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9779 /* Initialize the color table. */
9780 init_color_table ();
9782 /* For each pixel of the image, look its color up in the
9783 color table. After having done so, the color table will
9784 contain an entry for each color used by the image. */
9785 for (y
= 0; y
< img
->height
; ++y
)
9786 for (x
= 0; x
< img
->width
; ++x
)
9788 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9789 lookup_pixel_color (f
, pixel
);
9792 /* Record colors in the image. Free color table and XImage. */
9793 img
->colors
= colors_in_color_table (&img
->ncolors
);
9794 free_color_table ();
9795 XDestroyImage (ximg
);
9797 #if 0 /* This doesn't seem to be the case. If we free the colors
9798 here, we get a BadAccess later in x_clear_image when
9799 freeing the colors. */
9800 /* We have allocated colors once, but Ghostscript has also
9801 allocated colors on behalf of us. So, to get the
9802 reference counts right, free them once. */
9804 x_free_colors (f
, img
->colors
, img
->ncolors
);
9808 image_error ("Cannot get X image of `%s'; colors will not be freed",
9817 /***********************************************************************
9819 ***********************************************************************/
9821 DEFUN ("x-change-window-property", Fx_change_window_property
,
9822 Sx_change_window_property
, 2, 3, 0,
9823 "Change window property PROP to VALUE on the X window of FRAME.\n\
9824 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9825 selected frame. Value is VALUE.")
9826 (prop
, value
, frame
)
9827 Lisp_Object frame
, prop
, value
;
9829 struct frame
*f
= check_x_frame (frame
);
9832 CHECK_STRING (prop
, 1);
9833 CHECK_STRING (value
, 2);
9836 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9837 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9838 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9839 XSTRING (value
)->data
, XSTRING (value
)->size
);
9841 /* Make sure the property is set when we return. */
9842 XFlush (FRAME_X_DISPLAY (f
));
9849 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9850 Sx_delete_window_property
, 1, 2, 0,
9851 "Remove window property PROP from X window of FRAME.\n\
9852 FRAME nil or omitted means use the selected frame. Value is PROP.")
9854 Lisp_Object prop
, frame
;
9856 struct frame
*f
= check_x_frame (frame
);
9859 CHECK_STRING (prop
, 1);
9861 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9862 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9864 /* Make sure the property is removed when we return. */
9865 XFlush (FRAME_X_DISPLAY (f
));
9872 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9874 "Value is the value of window property PROP on FRAME.\n\
9875 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9876 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9879 Lisp_Object prop
, frame
;
9881 struct frame
*f
= check_x_frame (frame
);
9884 Lisp_Object prop_value
= Qnil
;
9885 char *tmp_data
= NULL
;
9888 unsigned long actual_size
, bytes_remaining
;
9890 CHECK_STRING (prop
, 1);
9892 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9893 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9894 prop_atom
, 0, 0, False
, XA_STRING
,
9895 &actual_type
, &actual_format
, &actual_size
,
9896 &bytes_remaining
, (unsigned char **) &tmp_data
);
9899 int size
= bytes_remaining
;
9904 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9905 prop_atom
, 0, bytes_remaining
,
9907 &actual_type
, &actual_format
,
9908 &actual_size
, &bytes_remaining
,
9909 (unsigned char **) &tmp_data
);
9911 prop_value
= make_string (tmp_data
, size
);
9922 /***********************************************************************
9924 ***********************************************************************/
9926 /* If non-null, an asynchronous timer that, when it expires, displays
9927 a busy cursor on all frames. */
9929 static struct atimer
*busy_cursor_atimer
;
9931 /* Non-zero means a busy cursor is currently shown. */
9933 static int busy_cursor_shown_p
;
9935 /* Number of seconds to wait before displaying a busy cursor. */
9937 static Lisp_Object Vbusy_cursor_delay
;
9939 /* Default number of seconds to wait before displaying a busy
9942 #define DEFAULT_BUSY_CURSOR_DELAY 1
9944 /* Function prototypes. */
9946 static void show_busy_cursor
P_ ((struct atimer
*));
9947 static void hide_busy_cursor
P_ ((void));
9950 /* Cancel a currently active busy-cursor timer, and start a new one. */
9953 start_busy_cursor ()
9956 int secs
, usecs
= 0;
9958 cancel_busy_cursor ();
9960 if (INTEGERP (Vbusy_cursor_delay
)
9961 && XINT (Vbusy_cursor_delay
) > 0)
9962 secs
= XFASTINT (Vbusy_cursor_delay
);
9963 else if (FLOATP (Vbusy_cursor_delay
)
9964 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
9967 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
9968 secs
= XFASTINT (tem
);
9969 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
9972 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
9974 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
9975 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
9976 show_busy_cursor
, NULL
);
9980 /* Cancel the busy cursor timer if active, hide a busy cursor if
9984 cancel_busy_cursor ()
9986 if (busy_cursor_atimer
)
9988 cancel_atimer (busy_cursor_atimer
);
9989 busy_cursor_atimer
= NULL
;
9992 if (busy_cursor_shown_p
)
9993 hide_busy_cursor ();
9997 /* Timer function of busy_cursor_atimer. TIMER is equal to
10000 Display a busy cursor on all frames by mapping the frames'
10001 busy_window. Set the busy_p flag in the frames' output_data.x
10002 structure to indicate that a busy cursor is shown on the
10006 show_busy_cursor (timer
)
10007 struct atimer
*timer
;
10009 /* The timer implementation will cancel this timer automatically
10010 after this function has run. Set busy_cursor_atimer to null
10011 so that we know the timer doesn't have to be canceled. */
10012 busy_cursor_atimer
= NULL
;
10014 if (!busy_cursor_shown_p
)
10016 Lisp_Object rest
, frame
;
10020 FOR_EACH_FRAME (rest
, frame
)
10021 if (FRAME_X_P (XFRAME (frame
)))
10023 struct frame
*f
= XFRAME (frame
);
10025 f
->output_data
.x
->busy_p
= 1;
10027 if (!f
->output_data
.x
->busy_window
)
10029 unsigned long mask
= CWCursor
;
10030 XSetWindowAttributes attrs
;
10032 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10034 f
->output_data
.x
->busy_window
10035 = XCreateWindow (FRAME_X_DISPLAY (f
),
10036 FRAME_OUTER_WINDOW (f
),
10037 0, 0, 32000, 32000, 0, 0,
10043 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10044 XFlush (FRAME_X_DISPLAY (f
));
10047 busy_cursor_shown_p
= 1;
10053 /* Hide the busy cursor on all frames, if it is currently shown. */
10056 hide_busy_cursor ()
10058 if (busy_cursor_shown_p
)
10060 Lisp_Object rest
, frame
;
10063 FOR_EACH_FRAME (rest
, frame
)
10065 struct frame
*f
= XFRAME (frame
);
10068 /* Watch out for newly created frames. */
10069 && f
->output_data
.x
->busy_window
)
10071 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10072 /* Sync here because XTread_socket looks at the busy_p flag
10073 that is reset to zero below. */
10074 XSync (FRAME_X_DISPLAY (f
), False
);
10075 f
->output_data
.x
->busy_p
= 0;
10079 busy_cursor_shown_p
= 0;
10086 /***********************************************************************
10088 ***********************************************************************/
10090 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10093 /* The frame of a currently visible tooltip, or null. */
10095 struct frame
*tip_frame
;
10097 /* If non-nil, a timer started that hides the last tooltip when it
10100 Lisp_Object tip_timer
;
10103 /* Create a frame for a tooltip on the display described by DPYINFO.
10104 PARMS is a list of frame parameters. Value is the frame. */
10107 x_create_tip_frame (dpyinfo
, parms
)
10108 struct x_display_info
*dpyinfo
;
10112 Lisp_Object frame
, tem
;
10114 long window_prompting
= 0;
10116 int count
= specpdl_ptr
- specpdl
;
10117 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10122 /* Use this general default value to start with until we know if
10123 this frame has a specified name. */
10124 Vx_resource_name
= Vinvocation_name
;
10126 #ifdef MULTI_KBOARD
10127 kb
= dpyinfo
->kboard
;
10129 kb
= &the_only_kboard
;
10132 /* Get the name of the frame to use for resource lookup. */
10133 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10134 if (!STRINGP (name
)
10135 && !EQ (name
, Qunbound
)
10137 error ("Invalid frame name--not a string or nil");
10138 Vx_resource_name
= name
;
10141 GCPRO3 (parms
, name
, frame
);
10142 tip_frame
= f
= make_frame (1);
10143 XSETFRAME (frame
, f
);
10144 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10146 f
->output_method
= output_x_window
;
10147 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10148 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10149 f
->output_data
.x
->icon_bitmap
= -1;
10150 f
->output_data
.x
->fontset
= -1;
10151 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10152 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10153 f
->icon_name
= Qnil
;
10154 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10155 #ifdef MULTI_KBOARD
10156 FRAME_KBOARD (f
) = kb
;
10158 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10159 f
->output_data
.x
->explicit_parent
= 0;
10161 /* These colors will be set anyway later, but it's important
10162 to get the color reference counts right, so initialize them! */
10165 struct gcpro gcpro1
;
10167 black
= build_string ("black");
10169 f
->output_data
.x
->foreground_pixel
10170 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10171 f
->output_data
.x
->background_pixel
10172 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10173 f
->output_data
.x
->cursor_pixel
10174 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10175 f
->output_data
.x
->cursor_foreground_pixel
10176 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10177 f
->output_data
.x
->border_pixel
10178 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10179 f
->output_data
.x
->mouse_pixel
10180 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10184 /* Set the name; the functions to which we pass f expect the name to
10186 if (EQ (name
, Qunbound
) || NILP (name
))
10188 f
->name
= build_string (dpyinfo
->x_id_name
);
10189 f
->explicit_name
= 0;
10194 f
->explicit_name
= 1;
10195 /* use the frame's title when getting resources for this frame. */
10196 specbind (Qx_resource_name
, name
);
10199 /* Extract the window parameters from the supplied values
10200 that are needed to determine window geometry. */
10204 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10207 /* First, try whatever font the caller has specified. */
10208 if (STRINGP (font
))
10210 tem
= Fquery_fontset (font
, Qnil
);
10212 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10214 font
= x_new_font (f
, XSTRING (font
)->data
);
10217 /* Try out a font which we hope has bold and italic variations. */
10218 if (!STRINGP (font
))
10219 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10220 if (!STRINGP (font
))
10221 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10222 if (! STRINGP (font
))
10223 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10224 if (! STRINGP (font
))
10225 /* This was formerly the first thing tried, but it finds too many fonts
10226 and takes too long. */
10227 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10228 /* If those didn't work, look for something which will at least work. */
10229 if (! STRINGP (font
))
10230 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10232 if (! STRINGP (font
))
10233 font
= build_string ("fixed");
10235 x_default_parameter (f
, parms
, Qfont
, font
,
10236 "font", "Font", RES_TYPE_STRING
);
10239 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10240 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10242 /* This defaults to 2 in order to match xterm. We recognize either
10243 internalBorderWidth or internalBorder (which is what xterm calls
10245 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10249 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10250 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10251 if (! EQ (value
, Qunbound
))
10252 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10256 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10257 "internalBorderWidth", "internalBorderWidth",
10260 /* Also do the stuff which must be set before the window exists. */
10261 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10262 "foreground", "Foreground", RES_TYPE_STRING
);
10263 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10264 "background", "Background", RES_TYPE_STRING
);
10265 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10266 "pointerColor", "Foreground", RES_TYPE_STRING
);
10267 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10268 "cursorColor", "Foreground", RES_TYPE_STRING
);
10269 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10270 "borderColor", "BorderColor", RES_TYPE_STRING
);
10272 /* Init faces before x_default_parameter is called for scroll-bar
10273 parameters because that function calls x_set_scroll_bar_width,
10274 which calls change_frame_size, which calls Fset_window_buffer,
10275 which runs hooks, which call Fvertical_motion. At the end, we
10276 end up in init_iterator with a null face cache, which should not
10278 init_frame_faces (f
);
10280 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10281 window_prompting
= x_figure_window_size (f
, parms
);
10283 if (window_prompting
& XNegative
)
10285 if (window_prompting
& YNegative
)
10286 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10288 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10292 if (window_prompting
& YNegative
)
10293 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10295 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10298 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10300 XSetWindowAttributes attrs
;
10301 unsigned long mask
;
10304 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10305 /* Window managers look at the override-redirect flag to determine
10306 whether or net to give windows a decoration (Xlib spec, chapter
10308 attrs
.override_redirect
= True
;
10309 attrs
.save_under
= True
;
10310 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10311 /* Arrange for getting MapNotify and UnmapNotify events. */
10312 attrs
.event_mask
= StructureNotifyMask
;
10314 = FRAME_X_WINDOW (f
)
10315 = XCreateWindow (FRAME_X_DISPLAY (f
),
10316 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10317 /* x, y, width, height */
10321 CopyFromParent
, InputOutput
, CopyFromParent
,
10328 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10329 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10330 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10331 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10332 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10333 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10335 /* Dimensions, especially f->height, must be done via change_frame_size.
10336 Change will not be effected unless different from the current
10339 height
= f
->height
;
10341 SET_FRAME_WIDTH (f
, 0);
10342 change_frame_size (f
, height
, width
, 1, 0, 0);
10348 /* It is now ok to make the frame official even if we get an error
10349 below. And the frame needs to be on Vframe_list or making it
10350 visible won't work. */
10351 Vframe_list
= Fcons (frame
, Vframe_list
);
10353 /* Now that the frame is official, it counts as a reference to
10355 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10357 return unbind_to (count
, frame
);
10361 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10362 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10363 A tooltip window is a small X window displaying a string.\n\
10365 FRAME nil or omitted means use the selected frame.\n\
10367 PARMS is an optional list of frame parameters which can be\n\
10368 used to change the tooltip's appearance.\n\
10370 Automatically hide the tooltip after TIMEOUT seconds.\n\
10371 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10373 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10374 the tooltip is displayed at that x-position. Otherwise it is\n\
10375 displayed at the mouse position, with offset DX added (default is 5 if\n\
10376 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10377 parameter is specified, it determines the y-position of the tooltip\n\
10378 window, otherwise it is displayed at the mouse position, with offset\n\
10379 DY added (default is -5).")
10380 (string
, frame
, parms
, timeout
, dx
, dy
)
10381 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10385 Window root
, child
;
10386 Lisp_Object buffer
, top
, left
;
10387 struct buffer
*old_buffer
;
10388 struct text_pos pos
;
10389 int i
, width
, height
;
10390 int root_x
, root_y
, win_x
, win_y
;
10392 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10393 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10394 int count
= specpdl_ptr
- specpdl
;
10396 specbind (Qinhibit_redisplay
, Qt
);
10398 GCPRO4 (string
, parms
, frame
, timeout
);
10400 CHECK_STRING (string
, 0);
10401 f
= check_x_frame (frame
);
10402 if (NILP (timeout
))
10403 timeout
= make_number (5);
10405 CHECK_NATNUM (timeout
, 2);
10408 dx
= make_number (5);
10410 CHECK_NUMBER (dx
, 5);
10413 dy
= make_number (-5);
10415 CHECK_NUMBER (dy
, 6);
10417 /* Hide a previous tip, if any. */
10420 /* Add default values to frame parameters. */
10421 if (NILP (Fassq (Qname
, parms
)))
10422 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10423 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10424 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10425 if (NILP (Fassq (Qborder_width
, parms
)))
10426 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10427 if (NILP (Fassq (Qborder_color
, parms
)))
10428 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10429 if (NILP (Fassq (Qbackground_color
, parms
)))
10430 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10433 /* Create a frame for the tooltip, and record it in the global
10434 variable tip_frame. */
10435 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10436 tip_frame
= f
= XFRAME (frame
);
10438 /* Set up the frame's root window. Currently we use a size of 80
10439 columns x 40 lines. If someone wants to show a larger tip, he
10440 will loose. I don't think this is a realistic case. */
10441 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10442 w
->left
= w
->top
= make_number (0);
10443 w
->width
= make_number (80);
10444 w
->height
= make_number (40);
10446 w
->pseudo_window_p
= 1;
10448 /* Display the tooltip text in a temporary buffer. */
10449 buffer
= Fget_buffer_create (build_string (" *tip*"));
10450 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10451 old_buffer
= current_buffer
;
10452 set_buffer_internal_1 (XBUFFER (buffer
));
10454 Finsert (1, &string
);
10455 clear_glyph_matrix (w
->desired_matrix
);
10456 clear_glyph_matrix (w
->current_matrix
);
10457 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10458 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10460 /* Compute width and height of the tooltip. */
10461 width
= height
= 0;
10462 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10464 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10465 struct glyph
*last
;
10468 /* Stop at the first empty row at the end. */
10469 if (!row
->enabled_p
|| !row
->displays_text_p
)
10472 /* Let the row go over the full width of the frame. */
10473 row
->full_width_p
= 1;
10475 /* There's a glyph at the end of rows that is used to place
10476 the cursor there. Don't include the width of this glyph. */
10477 if (row
->used
[TEXT_AREA
])
10479 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10480 row_width
= row
->pixel_width
- last
->pixel_width
;
10483 row_width
= row
->pixel_width
;
10485 height
+= row
->height
;
10486 width
= max (width
, row_width
);
10489 /* Add the frame's internal border to the width and height the X
10490 window should have. */
10491 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10492 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10494 /* User-specified position? */
10495 left
= Fcdr (Fassq (Qleft
, parms
));
10496 top
= Fcdr (Fassq (Qtop
, parms
));
10498 /* Move the tooltip window where the mouse pointer is. Resize and
10501 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10502 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10505 root_x
+= XINT (dx
);
10506 root_y
+= XINT (dy
);
10508 if (INTEGERP (left
))
10509 root_x
= XINT (left
);
10510 if (INTEGERP (top
))
10511 root_y
= XINT (top
);
10514 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10515 root_x
, root_y
- height
, width
, height
);
10516 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10519 /* Draw into the window. */
10520 w
->must_be_updated_p
= 1;
10521 update_single_window (w
, 1);
10523 /* Restore original current buffer. */
10524 set_buffer_internal_1 (old_buffer
);
10525 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10527 /* Let the tip disappear after timeout seconds. */
10528 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10529 intern ("x-hide-tip"));
10532 return unbind_to (count
, Qnil
);
10536 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10537 "Hide the current tooltip window, if there is any.\n\
10538 Value is t is tooltip was open, nil otherwise.")
10541 int count
= specpdl_ptr
- specpdl
;
10544 specbind (Qinhibit_redisplay
, Qt
);
10546 if (!NILP (tip_timer
))
10548 call1 (intern ("cancel-timer"), tip_timer
);
10556 XSETFRAME (frame
, tip_frame
);
10557 Fdelete_frame (frame
, Qt
);
10562 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10567 /***********************************************************************
10568 File selection dialog
10569 ***********************************************************************/
10573 /* Callback for "OK" and "Cancel" on file selection dialog. */
10576 file_dialog_cb (widget
, client_data
, call_data
)
10578 XtPointer call_data
, client_data
;
10580 int *result
= (int *) client_data
;
10581 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10582 *result
= cb
->reason
;
10586 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10587 "Read file name, prompting with PROMPT in directory DIR.\n\
10588 Use a file selection dialog.\n\
10589 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10590 specified. Don't let the user enter a file name in the file\n\
10591 selection dialog's entry field, if MUSTMATCH is non-nil.")
10592 (prompt
, dir
, default_filename
, mustmatch
)
10593 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10596 struct frame
*f
= SELECTED_FRAME ();
10597 Lisp_Object file
= Qnil
;
10598 Widget dialog
, text
, list
, help
;
10601 extern XtAppContext Xt_app_con
;
10603 XmString dir_xmstring
, pattern_xmstring
;
10604 int popup_activated_flag
;
10605 int count
= specpdl_ptr
- specpdl
;
10606 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10608 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10609 CHECK_STRING (prompt
, 0);
10610 CHECK_STRING (dir
, 1);
10612 /* Prevent redisplay. */
10613 specbind (Qinhibit_redisplay
, Qt
);
10617 /* Create the dialog with PROMPT as title, using DIR as initial
10618 directory and using "*" as pattern. */
10619 dir
= Fexpand_file_name (dir
, Qnil
);
10620 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10621 pattern_xmstring
= XmStringCreateLocalized ("*");
10623 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10624 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10625 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10626 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10627 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10628 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10630 XmStringFree (dir_xmstring
);
10631 XmStringFree (pattern_xmstring
);
10633 /* Add callbacks for OK and Cancel. */
10634 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10635 (XtPointer
) &result
);
10636 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10637 (XtPointer
) &result
);
10639 /* Disable the help button since we can't display help. */
10640 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10641 XtSetSensitive (help
, False
);
10643 /* Mark OK button as default. */
10644 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10645 XmNshowAsDefault
, True
, NULL
);
10647 /* If MUSTMATCH is non-nil, disable the file entry field of the
10648 dialog, so that the user must select a file from the files list
10649 box. We can't remove it because we wouldn't have a way to get at
10650 the result file name, then. */
10651 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10652 if (!NILP (mustmatch
))
10655 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10656 XtSetSensitive (text
, False
);
10657 XtSetSensitive (label
, False
);
10660 /* Manage the dialog, so that list boxes get filled. */
10661 XtManageChild (dialog
);
10663 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10664 must include the path for this to work. */
10665 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10666 if (STRINGP (default_filename
))
10668 XmString default_xmstring
;
10672 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10674 if (!XmListItemExists (list
, default_xmstring
))
10676 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10677 XmListAddItem (list
, default_xmstring
, 0);
10681 item_pos
= XmListItemPos (list
, default_xmstring
);
10682 XmStringFree (default_xmstring
);
10684 /* Select the item and scroll it into view. */
10685 XmListSelectPos (list
, item_pos
, True
);
10686 XmListSetPos (list
, item_pos
);
10689 #ifdef HAVE_MOTIF_2_1
10691 /* Process events until the user presses Cancel or OK. */
10693 while (result
== 0 || XtAppPending (Xt_app_con
))
10694 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10696 #else /* not HAVE_MOTIF_2_1 */
10698 /* Process all events until the user presses Cancel or OK. */
10699 for (result
= 0; result
== 0;)
10702 Widget widget
, parent
;
10704 XtAppNextEvent (Xt_app_con
, &event
);
10706 /* See if the receiver of the event is one of the widgets of
10707 the file selection dialog. If so, dispatch it. If not,
10709 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10711 while (parent
&& parent
!= dialog
)
10712 parent
= XtParent (parent
);
10714 if (parent
== dialog
10715 || (event
.type
== Expose
10716 && !process_expose_from_menu (event
)))
10717 XtDispatchEvent (&event
);
10720 #endif /* not HAVE_MOTIF_2_1 */
10722 /* Get the result. */
10723 if (result
== XmCR_OK
)
10728 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
10729 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10730 XmStringFree (text
);
10731 file
= build_string (data
);
10738 XtUnmanageChild (dialog
);
10739 XtDestroyWidget (dialog
);
10743 /* Make "Cancel" equivalent to C-g. */
10745 Fsignal (Qquit
, Qnil
);
10747 return unbind_to (count
, file
);
10750 #endif /* USE_MOTIF */
10754 /***********************************************************************
10756 ***********************************************************************/
10761 /* This is zero if not using X windows. */
10764 /* The section below is built by the lisp expression at the top of the file,
10765 just above where these variables are declared. */
10766 /*&&& init symbols here &&&*/
10767 Qauto_raise
= intern ("auto-raise");
10768 staticpro (&Qauto_raise
);
10769 Qauto_lower
= intern ("auto-lower");
10770 staticpro (&Qauto_lower
);
10771 Qbar
= intern ("bar");
10773 Qborder_color
= intern ("border-color");
10774 staticpro (&Qborder_color
);
10775 Qborder_width
= intern ("border-width");
10776 staticpro (&Qborder_width
);
10777 Qbox
= intern ("box");
10779 Qcursor_color
= intern ("cursor-color");
10780 staticpro (&Qcursor_color
);
10781 Qcursor_type
= intern ("cursor-type");
10782 staticpro (&Qcursor_type
);
10783 Qgeometry
= intern ("geometry");
10784 staticpro (&Qgeometry
);
10785 Qicon_left
= intern ("icon-left");
10786 staticpro (&Qicon_left
);
10787 Qicon_top
= intern ("icon-top");
10788 staticpro (&Qicon_top
);
10789 Qicon_type
= intern ("icon-type");
10790 staticpro (&Qicon_type
);
10791 Qicon_name
= intern ("icon-name");
10792 staticpro (&Qicon_name
);
10793 Qinternal_border_width
= intern ("internal-border-width");
10794 staticpro (&Qinternal_border_width
);
10795 Qleft
= intern ("left");
10796 staticpro (&Qleft
);
10797 Qright
= intern ("right");
10798 staticpro (&Qright
);
10799 Qmouse_color
= intern ("mouse-color");
10800 staticpro (&Qmouse_color
);
10801 Qnone
= intern ("none");
10802 staticpro (&Qnone
);
10803 Qparent_id
= intern ("parent-id");
10804 staticpro (&Qparent_id
);
10805 Qscroll_bar_width
= intern ("scroll-bar-width");
10806 staticpro (&Qscroll_bar_width
);
10807 Qsuppress_icon
= intern ("suppress-icon");
10808 staticpro (&Qsuppress_icon
);
10809 Qundefined_color
= intern ("undefined-color");
10810 staticpro (&Qundefined_color
);
10811 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10812 staticpro (&Qvertical_scroll_bars
);
10813 Qvisibility
= intern ("visibility");
10814 staticpro (&Qvisibility
);
10815 Qwindow_id
= intern ("window-id");
10816 staticpro (&Qwindow_id
);
10817 Qouter_window_id
= intern ("outer-window-id");
10818 staticpro (&Qouter_window_id
);
10819 Qx_frame_parameter
= intern ("x-frame-parameter");
10820 staticpro (&Qx_frame_parameter
);
10821 Qx_resource_name
= intern ("x-resource-name");
10822 staticpro (&Qx_resource_name
);
10823 Quser_position
= intern ("user-position");
10824 staticpro (&Quser_position
);
10825 Quser_size
= intern ("user-size");
10826 staticpro (&Quser_size
);
10827 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10828 staticpro (&Qscroll_bar_foreground
);
10829 Qscroll_bar_background
= intern ("scroll-bar-background");
10830 staticpro (&Qscroll_bar_background
);
10831 Qscreen_gamma
= intern ("screen-gamma");
10832 staticpro (&Qscreen_gamma
);
10833 Qline_spacing
= intern ("line-spacing");
10834 staticpro (&Qline_spacing
);
10835 Qcenter
= intern ("center");
10836 staticpro (&Qcenter
);
10837 Qcompound_text
= intern ("compound-text");
10838 staticpro (&Qcompound_text
);
10839 /* This is the end of symbol initialization. */
10841 /* Text property `display' should be nonsticky by default. */
10842 Vtext_property_default_nonsticky
10843 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10846 Qlaplace
= intern ("laplace");
10847 staticpro (&Qlaplace
);
10848 Qemboss
= intern ("emboss");
10849 staticpro (&Qemboss
);
10850 Qedge_detection
= intern ("edge-detection");
10851 staticpro (&Qedge_detection
);
10852 Qheuristic
= intern ("heuristic");
10853 staticpro (&Qheuristic
);
10854 QCmatrix
= intern (":matrix");
10855 staticpro (&QCmatrix
);
10856 QCcolor_adjustment
= intern (":color-adjustment");
10857 staticpro (&QCcolor_adjustment
);
10858 QCmask
= intern (":mask");
10859 staticpro (&QCmask
);
10861 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10862 staticpro (&Qface_set_after_frame_default
);
10864 Fput (Qundefined_color
, Qerror_conditions
,
10865 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10866 Fput (Qundefined_color
, Qerror_message
,
10867 build_string ("Undefined color"));
10869 init_x_parm_symbols ();
10871 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
10872 "Non-nil means always draw a cross over disabled images.\n\
10873 Disabled images are those having an `:algorithm disabled' property.\n\
10874 A cross is always drawn on black & white displays.");
10875 cross_disabled_images
= 0;
10877 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10878 "List of directories to search for bitmap files for X.");
10879 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10881 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10882 "The shape of the pointer when over text.\n\
10883 Changing the value does not affect existing frames\n\
10884 unless you set the mouse color.");
10885 Vx_pointer_shape
= Qnil
;
10887 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10888 "The name Emacs uses to look up X resources.\n\
10889 `x-get-resource' uses this as the first component of the instance name\n\
10890 when requesting resource values.\n\
10891 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10892 was invoked, or to the value specified with the `-name' or `-rn'\n\
10893 switches, if present.\n\
10895 It may be useful to bind this variable locally around a call\n\
10896 to `x-get-resource'. See also the variable `x-resource-class'.");
10897 Vx_resource_name
= Qnil
;
10899 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10900 "The class Emacs uses to look up X resources.\n\
10901 `x-get-resource' uses this as the first component of the instance class\n\
10902 when requesting resource values.\n\
10903 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10905 Setting this variable permanently is not a reasonable thing to do,\n\
10906 but binding this variable locally around a call to `x-get-resource'\n\
10907 is a reasonable practice. See also the variable `x-resource-name'.");
10908 Vx_resource_class
= build_string (EMACS_CLASS
);
10910 #if 0 /* This doesn't really do anything. */
10911 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10912 "The shape of the pointer when not over text.\n\
10913 This variable takes effect when you create a new frame\n\
10914 or when you set the mouse color.");
10916 Vx_nontext_pointer_shape
= Qnil
;
10918 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10919 "The shape of the pointer when Emacs is busy.\n\
10920 This variable takes effect when you create a new frame\n\
10921 or when you set the mouse color.");
10922 Vx_busy_pointer_shape
= Qnil
;
10924 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10925 "Non-zero means Emacs displays a busy cursor on window systems.");
10926 display_busy_cursor_p
= 1;
10928 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10929 "*Seconds to wait before displaying a busy-cursor.\n\
10930 Value must be an integer or float.");
10931 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10933 #if 0 /* This doesn't really do anything. */
10934 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10935 "The shape of the pointer when over the mode line.\n\
10936 This variable takes effect when you create a new frame\n\
10937 or when you set the mouse color.");
10939 Vx_mode_pointer_shape
= Qnil
;
10941 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10942 &Vx_sensitive_text_pointer_shape
,
10943 "The shape of the pointer when over mouse-sensitive text.\n\
10944 This variable takes effect when you create a new frame\n\
10945 or when you set the mouse color.");
10946 Vx_sensitive_text_pointer_shape
= Qnil
;
10948 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10949 "A string indicating the foreground color of the cursor box.");
10950 Vx_cursor_fore_pixel
= Qnil
;
10952 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10953 "Non-nil if no X window manager is in use.\n\
10954 Emacs doesn't try to figure this out; this is always nil\n\
10955 unless you set it to something else.");
10956 /* We don't have any way to find this out, so set it to nil
10957 and maybe the user would like to set it to t. */
10958 Vx_no_window_manager
= Qnil
;
10960 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10961 &Vx_pixel_size_width_font_regexp
,
10962 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10964 Since Emacs gets width of a font matching with this regexp from\n\
10965 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10966 such a font. This is especially effective for such large fonts as\n\
10967 Chinese, Japanese, and Korean.");
10968 Vx_pixel_size_width_font_regexp
= Qnil
;
10970 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10971 "Time after which cached images are removed from the cache.\n\
10972 When an image has not been displayed this many seconds, remove it\n\
10973 from the image cache. Value must be an integer or nil with nil\n\
10974 meaning don't clear the cache.");
10975 Vimage_cache_eviction_delay
= make_number (30 * 60);
10977 #ifdef USE_X_TOOLKIT
10978 Fprovide (intern ("x-toolkit"));
10981 Fprovide (intern ("motif"));
10984 defsubr (&Sx_get_resource
);
10986 /* X window properties. */
10987 defsubr (&Sx_change_window_property
);
10988 defsubr (&Sx_delete_window_property
);
10989 defsubr (&Sx_window_property
);
10991 defsubr (&Sxw_display_color_p
);
10992 defsubr (&Sx_display_grayscale_p
);
10993 defsubr (&Sxw_color_defined_p
);
10994 defsubr (&Sxw_color_values
);
10995 defsubr (&Sx_server_max_request_size
);
10996 defsubr (&Sx_server_vendor
);
10997 defsubr (&Sx_server_version
);
10998 defsubr (&Sx_display_pixel_width
);
10999 defsubr (&Sx_display_pixel_height
);
11000 defsubr (&Sx_display_mm_width
);
11001 defsubr (&Sx_display_mm_height
);
11002 defsubr (&Sx_display_screens
);
11003 defsubr (&Sx_display_planes
);
11004 defsubr (&Sx_display_color_cells
);
11005 defsubr (&Sx_display_visual_class
);
11006 defsubr (&Sx_display_backing_store
);
11007 defsubr (&Sx_display_save_under
);
11008 defsubr (&Sx_parse_geometry
);
11009 defsubr (&Sx_create_frame
);
11010 defsubr (&Sx_open_connection
);
11011 defsubr (&Sx_close_connection
);
11012 defsubr (&Sx_display_list
);
11013 defsubr (&Sx_synchronize
);
11014 defsubr (&Sx_focus_frame
);
11016 /* Setting callback functions for fontset handler. */
11017 get_font_info_func
= x_get_font_info
;
11019 #if 0 /* This function pointer doesn't seem to be used anywhere.
11020 And the pointer assigned has the wrong type, anyway. */
11021 list_fonts_func
= x_list_fonts
;
11024 load_font_func
= x_load_font
;
11025 find_ccl_program_func
= x_find_ccl_program
;
11026 query_font_func
= x_query_font
;
11027 set_frame_fontset_func
= x_set_font
;
11028 check_window_system_func
= check_x
;
11031 Qxbm
= intern ("xbm");
11033 QCtype
= intern (":type");
11034 staticpro (&QCtype
);
11035 QCalgorithm
= intern (":algorithm");
11036 staticpro (&QCalgorithm
);
11037 QCheuristic_mask
= intern (":heuristic-mask");
11038 staticpro (&QCheuristic_mask
);
11039 QCcolor_symbols
= intern (":color-symbols");
11040 staticpro (&QCcolor_symbols
);
11041 QCascent
= intern (":ascent");
11042 staticpro (&QCascent
);
11043 QCmargin
= intern (":margin");
11044 staticpro (&QCmargin
);
11045 QCrelief
= intern (":relief");
11046 staticpro (&QCrelief
);
11047 Qpostscript
= intern ("postscript");
11048 staticpro (&Qpostscript
);
11049 QCloader
= intern (":loader");
11050 staticpro (&QCloader
);
11051 QCbounding_box
= intern (":bounding-box");
11052 staticpro (&QCbounding_box
);
11053 QCpt_width
= intern (":pt-width");
11054 staticpro (&QCpt_width
);
11055 QCpt_height
= intern (":pt-height");
11056 staticpro (&QCpt_height
);
11057 QCindex
= intern (":index");
11058 staticpro (&QCindex
);
11059 Qpbm
= intern ("pbm");
11063 Qxpm
= intern ("xpm");
11068 Qjpeg
= intern ("jpeg");
11069 staticpro (&Qjpeg
);
11073 Qtiff
= intern ("tiff");
11074 staticpro (&Qtiff
);
11078 Qgif
= intern ("gif");
11083 Qpng
= intern ("png");
11087 defsubr (&Sclear_image_cache
);
11088 defsubr (&Simage_size
);
11089 defsubr (&Simage_mask_p
);
11091 busy_cursor_atimer
= NULL
;
11092 busy_cursor_shown_p
= 0;
11094 defsubr (&Sx_show_tip
);
11095 defsubr (&Sx_hide_tip
);
11096 staticpro (&tip_timer
);
11100 defsubr (&Sx_file_dialog
);
11108 image_types
= NULL
;
11109 Vimage_types
= Qnil
;
11111 define_image_type (&xbm_type
);
11112 define_image_type (&gs_type
);
11113 define_image_type (&pbm_type
);
11116 define_image_type (&xpm_type
);
11120 define_image_type (&jpeg_type
);
11124 define_image_type (&tiff_type
);
11128 define_image_type (&gif_type
);
11132 define_image_type (&png_type
);
11136 #endif /* HAVE_X_WINDOWS */