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
== None
&& !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_1
P_ ((struct frame
*, struct image
*, int,
5518 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5519 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5521 Lisp_Object color_name
,
5522 unsigned long dflt
));
5525 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5526 free the pixmap if any. MASK_P non-zero means clear the mask
5527 pixmap if any. COLORS_P non-zero means free colors allocated for
5528 the image, if any. */
5531 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5534 int pixmap_p
, mask_p
, colors_p
;
5536 if (pixmap_p
&& img
->pixmap
)
5538 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5542 if (mask_p
&& img
->mask
)
5544 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5548 if (colors_p
&& img
->ncolors
)
5550 x_free_colors (f
, img
->colors
, img
->ncolors
);
5551 xfree (img
->colors
);
5557 /* Free X resources of image IMG which is used on frame F. */
5560 x_clear_image (f
, img
)
5565 x_clear_image_1 (f
, img
, 1, 1, 1);
5570 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5571 cannot be allocated, use DFLT. Add a newly allocated color to
5572 IMG->colors, so that it can be freed again. Value is the pixel
5575 static unsigned long
5576 x_alloc_image_color (f
, img
, color_name
, dflt
)
5579 Lisp_Object color_name
;
5583 unsigned long result
;
5585 xassert (STRINGP (color_name
));
5587 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5589 /* This isn't called frequently so we get away with simply
5590 reallocating the color vector to the needed size, here. */
5593 (unsigned long *) xrealloc (img
->colors
,
5594 img
->ncolors
* sizeof *img
->colors
);
5595 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5596 result
= color
.pixel
;
5606 /***********************************************************************
5608 ***********************************************************************/
5610 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5613 /* Return a new, initialized image cache that is allocated from the
5614 heap. Call free_image_cache to free an image cache. */
5616 struct image_cache
*
5619 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5622 bzero (c
, sizeof *c
);
5624 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5625 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5626 c
->buckets
= (struct image
**) xmalloc (size
);
5627 bzero (c
->buckets
, size
);
5632 /* Free image cache of frame F. Be aware that X frames share images
5636 free_image_cache (f
)
5639 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5644 /* Cache should not be referenced by any frame when freed. */
5645 xassert (c
->refcount
== 0);
5647 for (i
= 0; i
< c
->used
; ++i
)
5648 free_image (f
, c
->images
[i
]);
5652 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5657 /* Clear image cache of frame F. FORCE_P non-zero means free all
5658 images. FORCE_P zero means clear only images that haven't been
5659 displayed for some time. Should be called from time to time to
5660 reduce the number of loaded images. If image-eviction-seconds is
5661 non-nil, this frees images in the cache which weren't displayed for
5662 at least that many seconds. */
5665 clear_image_cache (f
, force_p
)
5669 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5671 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5678 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5680 /* Block input so that we won't be interrupted by a SIGIO
5681 while being in an inconsistent state. */
5684 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5686 struct image
*img
= c
->images
[i
];
5688 && (force_p
|| img
->timestamp
< old
))
5690 free_image (f
, img
);
5695 /* We may be clearing the image cache because, for example,
5696 Emacs was iconified for a longer period of time. In that
5697 case, current matrices may still contain references to
5698 images freed above. So, clear these matrices. */
5701 Lisp_Object tail
, frame
;
5703 FOR_EACH_FRAME (tail
, frame
)
5705 struct frame
*f
= XFRAME (frame
);
5707 && FRAME_X_IMAGE_CACHE (f
) == c
)
5708 clear_current_matrices (f
);
5711 ++windows_or_buffers_changed
;
5719 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5721 "Clear the image cache of FRAME.\n\
5722 FRAME nil or omitted means use the selected frame.\n\
5723 FRAME t means clear the image caches of all frames.")
5731 FOR_EACH_FRAME (tail
, frame
)
5732 if (FRAME_X_P (XFRAME (frame
)))
5733 clear_image_cache (XFRAME (frame
), 1);
5736 clear_image_cache (check_x_frame (frame
), 1);
5742 /* Return the id of image with Lisp specification SPEC on frame F.
5743 SPEC must be a valid Lisp image specification (see valid_image_p). */
5746 lookup_image (f
, spec
)
5750 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5754 struct gcpro gcpro1
;
5757 /* F must be a window-system frame, and SPEC must be a valid image
5759 xassert (FRAME_WINDOW_P (f
));
5760 xassert (valid_image_p (spec
));
5764 /* Look up SPEC in the hash table of the image cache. */
5765 hash
= sxhash (spec
, 0);
5766 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5768 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5769 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5772 /* If not found, create a new image and cache it. */
5776 img
= make_image (spec
, hash
);
5777 cache_image (f
, img
);
5778 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5780 /* If we can't load the image, and we don't have a width and
5781 height, use some arbitrary width and height so that we can
5782 draw a rectangle for it. */
5783 if (img
->load_failed_p
)
5787 value
= image_spec_value (spec
, QCwidth
, NULL
);
5788 img
->width
= (INTEGERP (value
)
5789 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5790 value
= image_spec_value (spec
, QCheight
, NULL
);
5791 img
->height
= (INTEGERP (value
)
5792 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5796 /* Handle image type independent image attributes
5797 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5798 Lisp_Object ascent
, margin
, relief
;
5801 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5802 if (INTEGERP (ascent
))
5803 img
->ascent
= XFASTINT (ascent
);
5804 else if (EQ (ascent
, Qcenter
))
5805 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5807 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5808 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5809 img
->margin
= XFASTINT (margin
);
5811 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5812 if (INTEGERP (relief
))
5814 img
->relief
= XINT (relief
);
5815 img
->margin
+= abs (img
->relief
);
5818 /* Manipulation of the image's mask. */
5821 /* `:heuristic-mask t'
5823 means build a mask heuristically.
5824 `:heuristic-mask (R G B)'
5825 `:mask (heuristic (R G B))'
5826 means build a mask from color (R G B) in the
5829 means remove a mask, if any. */
5833 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5835 x_build_heuristic_mask (f
, img
, mask
);
5840 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5842 if (EQ (mask
, Qheuristic
))
5843 x_build_heuristic_mask (f
, img
, Qt
);
5844 else if (CONSP (mask
)
5845 && EQ (XCAR (mask
), Qheuristic
))
5847 if (CONSP (XCDR (mask
)))
5848 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5850 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5852 else if (NILP (mask
) && found_p
&& img
->mask
)
5854 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5860 /* Should we apply an image transformation algorithm? */
5863 Lisp_Object algorithm
;
5865 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5866 if (EQ (algorithm
, Qdisabled
))
5867 x_disable_image (f
, img
);
5868 else if (EQ (algorithm
, Qlaplace
))
5870 else if (EQ (algorithm
, Qemboss
))
5872 else if (CONSP (algorithm
)
5873 && EQ (XCAR (algorithm
), Qedge_detection
))
5876 tem
= XCDR (algorithm
);
5878 x_edge_detection (f
, img
,
5879 Fplist_get (tem
, QCmatrix
),
5880 Fplist_get (tem
, QCcolor_adjustment
));
5886 xassert (!interrupt_input_blocked
);
5889 /* We're using IMG, so set its timestamp to `now'. */
5890 EMACS_GET_TIME (now
);
5891 img
->timestamp
= EMACS_SECS (now
);
5895 /* Value is the image id. */
5900 /* Cache image IMG in the image cache of frame F. */
5903 cache_image (f
, img
)
5907 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5910 /* Find a free slot in c->images. */
5911 for (i
= 0; i
< c
->used
; ++i
)
5912 if (c
->images
[i
] == NULL
)
5915 /* If no free slot found, maybe enlarge c->images. */
5916 if (i
== c
->used
&& c
->used
== c
->size
)
5919 c
->images
= (struct image
**) xrealloc (c
->images
,
5920 c
->size
* sizeof *c
->images
);
5923 /* Add IMG to c->images, and assign IMG an id. */
5929 /* Add IMG to the cache's hash table. */
5930 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5931 img
->next
= c
->buckets
[i
];
5933 img
->next
->prev
= img
;
5935 c
->buckets
[i
] = img
;
5939 /* Call FN on every image in the image cache of frame F. Used to mark
5940 Lisp Objects in the image cache. */
5943 forall_images_in_image_cache (f
, fn
)
5945 void (*fn
) P_ ((struct image
*img
));
5947 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5949 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5953 for (i
= 0; i
< c
->used
; ++i
)
5962 /***********************************************************************
5964 ***********************************************************************/
5966 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5967 XImage
**, Pixmap
*));
5968 static void x_destroy_x_image
P_ ((XImage
*));
5969 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5972 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5973 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5974 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5975 via xmalloc. Print error messages via image_error if an error
5976 occurs. Value is non-zero if successful. */
5979 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5981 int width
, height
, depth
;
5985 Display
*display
= FRAME_X_DISPLAY (f
);
5986 Screen
*screen
= FRAME_X_SCREEN (f
);
5987 Window window
= FRAME_X_WINDOW (f
);
5989 xassert (interrupt_input_blocked
);
5992 depth
= DefaultDepthOfScreen (screen
);
5993 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5994 depth
, ZPixmap
, 0, NULL
, width
, height
,
5995 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5998 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6002 /* Allocate image raster. */
6003 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6005 /* Allocate a pixmap of the same size. */
6006 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6007 if (*pixmap
== None
)
6009 x_destroy_x_image (*ximg
);
6011 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6019 /* Destroy XImage XIMG. Free XIMG->data. */
6022 x_destroy_x_image (ximg
)
6025 xassert (interrupt_input_blocked
);
6030 XDestroyImage (ximg
);
6035 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6036 are width and height of both the image and pixmap. */
6039 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6046 xassert (interrupt_input_blocked
);
6047 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6048 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6049 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6054 /***********************************************************************
6056 ***********************************************************************/
6058 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6059 static char *slurp_file
P_ ((char *, int *));
6062 /* Find image file FILE. Look in data-directory, then
6063 x-bitmap-file-path. Value is the full name of the file found, or
6064 nil if not found. */
6067 x_find_image_file (file
)
6070 Lisp_Object file_found
, search_path
;
6071 struct gcpro gcpro1
, gcpro2
;
6075 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6076 GCPRO2 (file_found
, search_path
);
6078 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6079 fd
= openp (search_path
, file
, "", &file_found
, 0);
6091 /* Read FILE into memory. Value is a pointer to a buffer allocated
6092 with xmalloc holding FILE's contents. Value is null if an error
6093 occurred. *SIZE is set to the size of the file. */
6096 slurp_file (file
, size
)
6104 if (stat (file
, &st
) == 0
6105 && (fp
= fopen (file
, "r")) != NULL
6106 && (buf
= (char *) xmalloc (st
.st_size
),
6107 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6128 /***********************************************************************
6130 ***********************************************************************/
6132 static int xbm_scan
P_ ((char **, char *, char *, int *));
6133 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6134 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6136 static int xbm_image_p
P_ ((Lisp_Object object
));
6137 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6139 static int xbm_file_p
P_ ((Lisp_Object
));
6142 /* Indices of image specification fields in xbm_format, below. */
6144 enum xbm_keyword_index
6162 /* Vector of image_keyword structures describing the format
6163 of valid XBM image specifications. */
6165 static struct image_keyword xbm_format
[XBM_LAST
] =
6167 {":type", IMAGE_SYMBOL_VALUE
, 1},
6168 {":file", IMAGE_STRING_VALUE
, 0},
6169 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6170 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6171 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6172 {":foreground", IMAGE_STRING_VALUE
, 0},
6173 {":background", IMAGE_STRING_VALUE
, 0},
6174 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6175 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6176 {":relief", IMAGE_INTEGER_VALUE
, 0},
6177 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6178 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6179 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6182 /* Structure describing the image type XBM. */
6184 static struct image_type xbm_type
=
6193 /* Tokens returned from xbm_scan. */
6202 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6203 A valid specification is a list starting with the symbol `image'
6204 The rest of the list is a property list which must contain an
6207 If the specification specifies a file to load, it must contain
6208 an entry `:file FILENAME' where FILENAME is a string.
6210 If the specification is for a bitmap loaded from memory it must
6211 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6212 WIDTH and HEIGHT are integers > 0. DATA may be:
6214 1. a string large enough to hold the bitmap data, i.e. it must
6215 have a size >= (WIDTH + 7) / 8 * HEIGHT
6217 2. a bool-vector of size >= WIDTH * HEIGHT
6219 3. a vector of strings or bool-vectors, one for each line of the
6222 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6223 may not be specified in this case because they are defined in the
6226 Both the file and data forms may contain the additional entries
6227 `:background COLOR' and `:foreground COLOR'. If not present,
6228 foreground and background of the frame on which the image is
6229 displayed is used. */
6232 xbm_image_p (object
)
6235 struct image_keyword kw
[XBM_LAST
];
6237 bcopy (xbm_format
, kw
, sizeof kw
);
6238 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6241 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6243 if (kw
[XBM_FILE
].count
)
6245 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6248 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6250 /* In-memory XBM file. */
6251 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6259 /* Entries for `:width', `:height' and `:data' must be present. */
6260 if (!kw
[XBM_WIDTH
].count
6261 || !kw
[XBM_HEIGHT
].count
6262 || !kw
[XBM_DATA
].count
)
6265 data
= kw
[XBM_DATA
].value
;
6266 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6267 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6269 /* Check type of data, and width and height against contents of
6275 /* Number of elements of the vector must be >= height. */
6276 if (XVECTOR (data
)->size
< height
)
6279 /* Each string or bool-vector in data must be large enough
6280 for one line of the image. */
6281 for (i
= 0; i
< height
; ++i
)
6283 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6287 if (XSTRING (elt
)->size
6288 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6291 else if (BOOL_VECTOR_P (elt
))
6293 if (XBOOL_VECTOR (elt
)->size
< width
)
6300 else if (STRINGP (data
))
6302 if (XSTRING (data
)->size
6303 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6306 else if (BOOL_VECTOR_P (data
))
6308 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6319 /* Scan a bitmap file. FP is the stream to read from. Value is
6320 either an enumerator from enum xbm_token, or a character for a
6321 single-character token, or 0 at end of file. If scanning an
6322 identifier, store the lexeme of the identifier in SVAL. If
6323 scanning a number, store its value in *IVAL. */
6326 xbm_scan (s
, end
, sval
, ival
)
6335 /* Skip white space. */
6336 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6341 else if (isdigit (c
))
6343 int value
= 0, digit
;
6345 if (c
== '0' && *s
< end
)
6348 if (c
== 'x' || c
== 'X')
6355 else if (c
>= 'a' && c
<= 'f')
6356 digit
= c
- 'a' + 10;
6357 else if (c
>= 'A' && c
<= 'F')
6358 digit
= c
- 'A' + 10;
6361 value
= 16 * value
+ digit
;
6364 else if (isdigit (c
))
6368 && (c
= *(*s
)++, isdigit (c
)))
6369 value
= 8 * value
+ c
- '0';
6376 && (c
= *(*s
)++, isdigit (c
)))
6377 value
= 10 * value
+ c
- '0';
6385 else if (isalpha (c
) || c
== '_')
6389 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6396 else if (c
== '/' && **s
== '*')
6398 /* C-style comment. */
6400 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6413 /* Replacement for XReadBitmapFileData which isn't available under old
6414 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6415 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6416 the image. Return in *DATA the bitmap data allocated with xmalloc.
6417 Value is non-zero if successful. DATA null means just test if
6418 CONTENTS looks like an in-memory XBM file. */
6421 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6422 char *contents
, *end
;
6423 int *width
, *height
;
6424 unsigned char **data
;
6427 char buffer
[BUFSIZ
];
6430 int bytes_per_line
, i
, nbytes
;
6436 LA1 = xbm_scan (&s, end, buffer, &value)
6438 #define expect(TOKEN) \
6439 if (LA1 != (TOKEN)) \
6444 #define expect_ident(IDENT) \
6445 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6450 *width
= *height
= -1;
6453 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6455 /* Parse defines for width, height and hot-spots. */
6459 expect_ident ("define");
6460 expect (XBM_TK_IDENT
);
6462 if (LA1
== XBM_TK_NUMBER
);
6464 char *p
= strrchr (buffer
, '_');
6465 p
= p
? p
+ 1 : buffer
;
6466 if (strcmp (p
, "width") == 0)
6468 else if (strcmp (p
, "height") == 0)
6471 expect (XBM_TK_NUMBER
);
6474 if (*width
< 0 || *height
< 0)
6476 else if (data
== NULL
)
6479 /* Parse bits. Must start with `static'. */
6480 expect_ident ("static");
6481 if (LA1
== XBM_TK_IDENT
)
6483 if (strcmp (buffer
, "unsigned") == 0)
6486 expect_ident ("char");
6488 else if (strcmp (buffer
, "short") == 0)
6492 if (*width
% 16 && *width
% 16 < 9)
6495 else if (strcmp (buffer
, "char") == 0)
6503 expect (XBM_TK_IDENT
);
6509 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6510 nbytes
= bytes_per_line
* *height
;
6511 p
= *data
= (char *) xmalloc (nbytes
);
6515 for (i
= 0; i
< nbytes
; i
+= 2)
6518 expect (XBM_TK_NUMBER
);
6521 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6524 if (LA1
== ',' || LA1
== '}')
6532 for (i
= 0; i
< nbytes
; ++i
)
6535 expect (XBM_TK_NUMBER
);
6539 if (LA1
== ',' || LA1
== '}')
6564 /* Load XBM image IMG which will be displayed on frame F from buffer
6565 CONTENTS. END is the end of the buffer. Value is non-zero if
6569 xbm_load_image (f
, img
, contents
, end
)
6572 char *contents
, *end
;
6575 unsigned char *data
;
6578 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6581 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6582 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6583 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6586 xassert (img
->width
> 0 && img
->height
> 0);
6588 /* Get foreground and background colors, maybe allocate colors. */
6589 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6591 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6593 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6595 background
= x_alloc_image_color (f
, img
, value
, background
);
6598 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6601 img
->width
, img
->height
,
6602 foreground
, background
,
6606 if (img
->pixmap
== None
)
6608 x_clear_image (f
, img
);
6609 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6615 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6621 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6628 return (STRINGP (data
)
6629 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6630 (XSTRING (data
)->data
6631 + STRING_BYTES (XSTRING (data
))),
6636 /* Fill image IMG which is used on frame F with pixmap data. Value is
6637 non-zero if successful. */
6645 Lisp_Object file_name
;
6647 xassert (xbm_image_p (img
->spec
));
6649 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6650 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6651 if (STRINGP (file_name
))
6656 struct gcpro gcpro1
;
6658 file
= x_find_image_file (file_name
);
6660 if (!STRINGP (file
))
6662 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6667 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6668 if (contents
== NULL
)
6670 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6675 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6680 struct image_keyword fmt
[XBM_LAST
];
6682 unsigned char *bitmap_data
;
6684 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6685 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6687 int parsed_p
, height
, width
;
6688 int in_memory_file_p
= 0;
6690 /* See if data looks like an in-memory XBM file. */
6691 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6692 in_memory_file_p
= xbm_file_p (data
);
6694 /* Parse the image specification. */
6695 bcopy (xbm_format
, fmt
, sizeof fmt
);
6696 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6699 /* Get specified width, and height. */
6700 if (!in_memory_file_p
)
6702 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6703 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6704 xassert (img
->width
> 0 && img
->height
> 0);
6707 /* Get foreground and background colors, maybe allocate colors. */
6708 if (fmt
[XBM_FOREGROUND
].count
)
6709 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6711 if (fmt
[XBM_BACKGROUND
].count
)
6712 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6715 if (in_memory_file_p
)
6716 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6717 (XSTRING (data
)->data
6718 + STRING_BYTES (XSTRING (data
))));
6725 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6727 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6728 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6730 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6732 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6734 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6737 else if (STRINGP (data
))
6738 bits
= XSTRING (data
)->data
;
6740 bits
= XBOOL_VECTOR (data
)->data
;
6742 /* Create the pixmap. */
6743 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6745 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6748 img
->width
, img
->height
,
6749 foreground
, background
,
6755 image_error ("Unable to create pixmap for XBM image `%s'",
6757 x_clear_image (f
, img
);
6767 /***********************************************************************
6769 ***********************************************************************/
6773 static int xpm_image_p
P_ ((Lisp_Object object
));
6774 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6775 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6777 #include "X11/xpm.h"
6779 /* The symbol `xpm' identifying XPM-format images. */
6783 /* Indices of image specification fields in xpm_format, below. */
6785 enum xpm_keyword_index
6800 /* Vector of image_keyword structures describing the format
6801 of valid XPM image specifications. */
6803 static struct image_keyword xpm_format
[XPM_LAST
] =
6805 {":type", IMAGE_SYMBOL_VALUE
, 1},
6806 {":file", IMAGE_STRING_VALUE
, 0},
6807 {":data", IMAGE_STRING_VALUE
, 0},
6808 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6809 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6810 {":relief", IMAGE_INTEGER_VALUE
, 0},
6811 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6812 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6813 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6814 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6817 /* Structure describing the image type XBM. */
6819 static struct image_type xpm_type
=
6829 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6830 functions for allocating image colors. Our own functions handle
6831 color allocation failures more gracefully than the ones on the XPM
6834 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6835 #define ALLOC_XPM_COLORS
6838 #ifdef ALLOC_XPM_COLORS
6840 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
6841 static void xpm_free_color_cache
P_ ((void));
6842 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6843 static int xpm_color_bucket
P_ ((char *));
6844 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
6847 /* An entry in a hash table used to cache color definitions of named
6848 colors. This cache is necessary to speed up XPM image loading in
6849 case we do color allocations ourselves. Without it, we would need
6850 a call to XParseColor per pixel in the image. */
6852 struct xpm_cached_color
6854 /* Next in collision chain. */
6855 struct xpm_cached_color
*next
;
6857 /* Color definition (RGB and pixel color). */
6864 /* The hash table used for the color cache, and its bucket vector
6867 #define XPM_COLOR_CACHE_BUCKETS 1001
6868 struct xpm_cached_color
**xpm_color_cache
;
6870 /* Initialize the color cache. */
6873 xpm_init_color_cache (f
, attrs
)
6875 XpmAttributes
*attrs
;
6877 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
6878 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
6879 memset (xpm_color_cache
, 0, nbytes
);
6880 init_color_table ();
6882 if (attrs
->valuemask
& XpmColorSymbols
)
6887 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
6888 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
6889 attrs
->colorsymbols
[i
].value
, &color
))
6891 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
6893 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
6899 /* Free the color cache. */
6902 xpm_free_color_cache ()
6904 struct xpm_cached_color
*p
, *next
;
6907 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
6908 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
6914 xfree (xpm_color_cache
);
6915 xpm_color_cache
= NULL
;
6916 free_color_table ();
6920 /* Return the bucket index for color named COLOR_NAME in the color
6924 xpm_color_bucket (color_name
)
6930 for (s
= color_name
; *s
; ++s
)
6932 return h
%= XPM_COLOR_CACHE_BUCKETS
;
6936 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6937 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6940 static struct xpm_cached_color
*
6941 xpm_cache_color (f
, color_name
, color
, bucket
)
6948 struct xpm_cached_color
*p
;
6951 bucket
= xpm_color_bucket (color_name
);
6953 nbytes
= sizeof *p
+ strlen (color_name
);
6954 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
6955 strcpy (p
->name
, color_name
);
6957 p
->next
= xpm_color_cache
[bucket
];
6958 xpm_color_cache
[bucket
] = p
;
6963 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6964 return the cached definition in *COLOR. Otherwise, make a new
6965 entry in the cache and allocate the color. Value is zero if color
6966 allocation failed. */
6969 xpm_lookup_color (f
, color_name
, color
)
6974 struct xpm_cached_color
*p
;
6975 int h
= xpm_color_bucket (color_name
);
6977 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
6978 if (strcmp (p
->name
, color_name
) == 0)
6983 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
6986 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
6988 p
= xpm_cache_color (f
, color_name
, color
, h
);
6995 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
6996 CLOSURE is a pointer to the frame on which we allocate the
6997 color. Return in *COLOR the allocated color. Value is non-zero
7001 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7008 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7012 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7013 is a pointer to the frame on which we allocate the color. Value is
7014 non-zero if successful. */
7017 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7027 #endif /* ALLOC_XPM_COLORS */
7030 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7031 for XPM images. Such a list must consist of conses whose car and
7035 xpm_valid_color_symbols_p (color_symbols
)
7036 Lisp_Object color_symbols
;
7038 while (CONSP (color_symbols
))
7040 Lisp_Object sym
= XCAR (color_symbols
);
7042 || !STRINGP (XCAR (sym
))
7043 || !STRINGP (XCDR (sym
)))
7045 color_symbols
= XCDR (color_symbols
);
7048 return NILP (color_symbols
);
7052 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7055 xpm_image_p (object
)
7058 struct image_keyword fmt
[XPM_LAST
];
7059 bcopy (xpm_format
, fmt
, sizeof fmt
);
7060 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7061 /* Either `:file' or `:data' must be present. */
7062 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7063 /* Either no `:color-symbols' or it's a list of conses
7064 whose car and cdr are strings. */
7065 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7066 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7070 /* Load image IMG which will be displayed on frame F. Value is
7071 non-zero if successful. */
7079 XpmAttributes attrs
;
7080 Lisp_Object specified_file
, color_symbols
;
7082 /* Configure the XPM lib. Use the visual of frame F. Allocate
7083 close colors. Return colors allocated. */
7084 bzero (&attrs
, sizeof attrs
);
7085 attrs
.visual
= FRAME_X_VISUAL (f
);
7086 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7087 attrs
.valuemask
|= XpmVisual
;
7088 attrs
.valuemask
|= XpmColormap
;
7090 #ifdef ALLOC_XPM_COLORS
7091 /* Allocate colors with our own functions which handle
7092 failing color allocation more gracefully. */
7093 attrs
.color_closure
= f
;
7094 attrs
.alloc_color
= xpm_alloc_color
;
7095 attrs
.free_colors
= xpm_free_colors
;
7096 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7097 #else /* not ALLOC_XPM_COLORS */
7098 /* Let the XPM lib allocate colors. */
7099 attrs
.valuemask
|= XpmReturnAllocPixels
;
7100 #ifdef XpmAllocCloseColors
7101 attrs
.alloc_close_colors
= 1;
7102 attrs
.valuemask
|= XpmAllocCloseColors
;
7103 #else /* not XpmAllocCloseColors */
7104 attrs
.closeness
= 600;
7105 attrs
.valuemask
|= XpmCloseness
;
7106 #endif /* not XpmAllocCloseColors */
7107 #endif /* ALLOC_XPM_COLORS */
7109 /* If image specification contains symbolic color definitions, add
7110 these to `attrs'. */
7111 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7112 if (CONSP (color_symbols
))
7115 XpmColorSymbol
*xpm_syms
;
7118 attrs
.valuemask
|= XpmColorSymbols
;
7120 /* Count number of symbols. */
7121 attrs
.numsymbols
= 0;
7122 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7125 /* Allocate an XpmColorSymbol array. */
7126 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7127 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7128 bzero (xpm_syms
, size
);
7129 attrs
.colorsymbols
= xpm_syms
;
7131 /* Fill the color symbol array. */
7132 for (tail
= color_symbols
, i
= 0;
7134 ++i
, tail
= XCDR (tail
))
7136 Lisp_Object name
= XCAR (XCAR (tail
));
7137 Lisp_Object color
= XCDR (XCAR (tail
));
7138 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7139 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7140 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7141 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7145 /* Create a pixmap for the image, either from a file, or from a
7146 string buffer containing data in the same format as an XPM file. */
7147 #ifdef ALLOC_XPM_COLORS
7148 xpm_init_color_cache (f
, &attrs
);
7151 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7152 if (STRINGP (specified_file
))
7154 Lisp_Object file
= x_find_image_file (specified_file
);
7155 if (!STRINGP (file
))
7157 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7161 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7162 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7167 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7168 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7169 XSTRING (buffer
)->data
,
7170 &img
->pixmap
, &img
->mask
,
7174 if (rc
== XpmSuccess
)
7176 #ifdef ALLOC_XPM_COLORS
7177 img
->colors
= colors_in_color_table (&img
->ncolors
);
7178 #else /* not ALLOC_XPM_COLORS */
7179 img
->ncolors
= attrs
.nalloc_pixels
;
7180 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7181 * sizeof *img
->colors
);
7182 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7184 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7185 #ifdef DEBUG_X_COLORS
7186 register_color (img
->colors
[i
]);
7189 #endif /* not ALLOC_XPM_COLORS */
7191 img
->width
= attrs
.width
;
7192 img
->height
= attrs
.height
;
7193 xassert (img
->width
> 0 && img
->height
> 0);
7195 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7196 XpmFreeAttributes (&attrs
);
7203 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7206 case XpmFileInvalid
:
7207 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7211 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7214 case XpmColorFailed
:
7215 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7219 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7224 #ifdef ALLOC_XPM_COLORS
7225 xpm_free_color_cache ();
7227 return rc
== XpmSuccess
;
7230 #endif /* HAVE_XPM != 0 */
7233 /***********************************************************************
7235 ***********************************************************************/
7237 /* An entry in the color table mapping an RGB color to a pixel color. */
7242 unsigned long pixel
;
7244 /* Next in color table collision list. */
7245 struct ct_color
*next
;
7248 /* The bucket vector size to use. Must be prime. */
7252 /* Value is a hash of the RGB color given by R, G, and B. */
7254 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7256 /* The color hash table. */
7258 struct ct_color
**ct_table
;
7260 /* Number of entries in the color table. */
7262 int ct_colors_allocated
;
7264 /* Initialize the color table. */
7269 int size
= CT_SIZE
* sizeof (*ct_table
);
7270 ct_table
= (struct ct_color
**) xmalloc (size
);
7271 bzero (ct_table
, size
);
7272 ct_colors_allocated
= 0;
7276 /* Free memory associated with the color table. */
7282 struct ct_color
*p
, *next
;
7284 for (i
= 0; i
< CT_SIZE
; ++i
)
7285 for (p
= ct_table
[i
]; p
; p
= next
)
7296 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7297 entry for that color already is in the color table, return the
7298 pixel color of that entry. Otherwise, allocate a new color for R,
7299 G, B, and make an entry in the color table. */
7301 static unsigned long
7302 lookup_rgb_color (f
, r
, g
, b
)
7306 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7307 int i
= hash
% CT_SIZE
;
7310 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7311 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7324 cmap
= FRAME_X_COLORMAP (f
);
7325 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7329 ++ct_colors_allocated
;
7331 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7335 p
->pixel
= color
.pixel
;
7336 p
->next
= ct_table
[i
];
7340 return FRAME_FOREGROUND_PIXEL (f
);
7347 /* Look up pixel color PIXEL which is used on frame F in the color
7348 table. If not already present, allocate it. Value is PIXEL. */
7350 static unsigned long
7351 lookup_pixel_color (f
, pixel
)
7353 unsigned long pixel
;
7355 int i
= pixel
% CT_SIZE
;
7358 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7359 if (p
->pixel
== pixel
)
7368 cmap
= FRAME_X_COLORMAP (f
);
7369 color
.pixel
= pixel
;
7370 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7371 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7375 ++ct_colors_allocated
;
7377 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7382 p
->next
= ct_table
[i
];
7386 return FRAME_FOREGROUND_PIXEL (f
);
7393 /* Value is a vector of all pixel colors contained in the color table,
7394 allocated via xmalloc. Set *N to the number of colors. */
7396 static unsigned long *
7397 colors_in_color_table (n
)
7402 unsigned long *colors
;
7404 if (ct_colors_allocated
== 0)
7411 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7413 *n
= ct_colors_allocated
;
7415 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7416 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7417 colors
[j
++] = p
->pixel
;
7425 /***********************************************************************
7427 ***********************************************************************/
7429 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7430 int, XImage
*, int));
7431 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7432 XColor
*, int, XImage
*, int));
7433 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7434 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7435 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7437 /* Non-zero means draw a cross on images having `:algorithm
7440 int cross_disabled_images
;
7442 /* Edge detection matrices for different edge-detection
7445 static int emboss_matrix
[9] = {
7447 2, -1, 0, /* y - 1 */
7449 0, 1, -2 /* y + 1 */
7452 static int laplace_matrix
[9] = {
7454 1, 0, 0, /* y - 1 */
7456 0, 0, -1 /* y + 1 */
7459 /* Value is the intensity of the color whose red/green/blue values
7462 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7465 /* On frame F, return an array of XColor structures describing image
7466 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7467 non-zero means also fill the red/green/blue members of the XColor
7468 structures. Value is a pointer to the array of XColors structures,
7469 allocated with xmalloc; it must be freed by the caller. */
7472 x_to_xcolors (f
, img
, rgb_p
)
7481 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7483 /* Get the X image IMG->pixmap. */
7484 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7485 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7487 /* Fill the `pixel' members of the XColor array. I wished there
7488 were an easy and portable way to circumvent XGetPixel. */
7490 for (y
= 0; y
< img
->height
; ++y
)
7494 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7495 p
->pixel
= XGetPixel (ximg
, x
, y
);
7498 XQueryColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7502 XDestroyImage (ximg
);
7507 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7508 RGB members are set. F is the frame on which this all happens.
7509 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7512 x_from_xcolors (f
, img
, colors
)
7522 init_color_table ();
7524 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7527 for (y
= 0; y
< img
->height
; ++y
)
7528 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7530 unsigned long pixel
;
7531 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7532 XPutPixel (oimg
, x
, y
, pixel
);
7536 x_clear_image_1 (f
, img
, 1, 0, 1);
7538 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7539 x_destroy_x_image (oimg
);
7540 img
->pixmap
= pixmap
;
7541 img
->colors
= colors_in_color_table (&img
->ncolors
);
7542 free_color_table ();
7546 /* On frame F, perform edge-detection on image IMG.
7548 MATRIX is a nine-element array specifying the transformation
7549 matrix. See emboss_matrix for an example.
7551 COLOR_ADJUST is a color adjustment added to each pixel of the
7555 x_detect_edges (f
, img
, matrix
, color_adjust
)
7558 int matrix
[9], color_adjust
;
7560 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7564 for (i
= sum
= 0; i
< 9; ++i
)
7565 sum
+= abs (matrix
[i
]);
7567 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7569 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7571 for (y
= 0; y
< img
->height
; ++y
)
7573 p
= COLOR (new, 0, y
);
7574 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7575 p
= COLOR (new, img
->width
- 1, y
);
7576 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7579 for (x
= 1; x
< img
->width
- 1; ++x
)
7581 p
= COLOR (new, x
, 0);
7582 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7583 p
= COLOR (new, x
, img
->height
- 1);
7584 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7587 for (y
= 1; y
< img
->height
- 1; ++y
)
7589 p
= COLOR (new, 1, y
);
7591 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7593 int r
, g
, b
, y1
, x1
;
7596 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7597 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7600 XColor
*t
= COLOR (colors
, x1
, y1
);
7601 r
+= matrix
[i
] * t
->red
;
7602 g
+= matrix
[i
] * t
->green
;
7603 b
+= matrix
[i
] * t
->blue
;
7606 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7607 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7608 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7609 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7614 x_from_xcolors (f
, img
, new);
7620 /* Perform the pre-defined `emboss' edge-detection on image IMG
7628 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7632 /* Perform the pre-defined `laplace' edge-detection on image IMG
7640 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7644 /* Perform edge-detection on image IMG on frame F, with specified
7645 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7647 MATRIX must be either
7649 - a list of at least 9 numbers in row-major form
7650 - a vector of at least 9 numbers
7652 COLOR_ADJUST nil means use a default; otherwise it must be a
7656 x_edge_detection (f
, img
, matrix
, color_adjust
)
7659 Lisp_Object matrix
, color_adjust
;
7667 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7668 ++i
, matrix
= XCDR (matrix
))
7669 trans
[i
] = XFLOATINT (XCAR (matrix
));
7671 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7673 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7674 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7677 if (NILP (color_adjust
))
7678 color_adjust
= make_number (0xffff / 2);
7680 if (i
== 9 && NUMBERP (color_adjust
))
7681 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7685 /* Transform image IMG on frame F so that it looks disabled. */
7688 x_disable_image (f
, img
)
7692 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7694 if (dpyinfo
->n_planes
>= 2)
7696 /* Color (or grayscale). Convert to gray, and equalize. Just
7697 drawing such images with a stipple can look very odd, so
7698 we're using this method instead. */
7699 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7701 const int h
= 15000;
7702 const int l
= 30000;
7704 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7708 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7709 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7710 p
->red
= p
->green
= p
->blue
= i2
;
7713 x_from_xcolors (f
, img
, colors
);
7716 /* Draw a cross over the disabled image, if we must or if we
7718 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7720 Display
*dpy
= FRAME_X_DISPLAY (f
);
7723 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7724 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7725 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7726 img
->width
- 1, img
->height
- 1);
7727 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7733 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7734 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7735 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7736 img
->width
- 1, img
->height
- 1);
7737 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7745 /* Build a mask for image IMG which is used on frame F. FILE is the
7746 name of an image file, for error messages. HOW determines how to
7747 determine the background color of IMG. If it is a list '(R G B)',
7748 with R, G, and B being integers >= 0, take that as the color of the
7749 background. Otherwise, determine the background color of IMG
7750 heuristically. Value is non-zero if successful. */
7753 x_build_heuristic_mask (f
, img
, how
)
7758 Display
*dpy
= FRAME_X_DISPLAY (f
);
7759 XImage
*ximg
, *mask_img
;
7760 int x
, y
, rc
, look_at_corners_p
;
7761 unsigned long bg
= 0;
7765 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7769 /* Create an image and pixmap serving as mask. */
7770 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7771 &mask_img
, &img
->mask
);
7775 /* Get the X image of IMG->pixmap. */
7776 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7779 /* Determine the background color of ximg. If HOW is `(R G B)'
7780 take that as color. Otherwise, try to determine the color
7782 look_at_corners_p
= 1;
7790 && NATNUMP (XCAR (how
)))
7792 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7796 if (i
== 3 && NILP (how
))
7798 char color_name
[30];
7799 XColor exact
, color
;
7802 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7804 cmap
= FRAME_X_COLORMAP (f
);
7805 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7808 look_at_corners_p
= 0;
7813 if (look_at_corners_p
)
7815 unsigned long corners
[4];
7818 /* Get the colors at the corners of ximg. */
7819 corners
[0] = XGetPixel (ximg
, 0, 0);
7820 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7821 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7822 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7824 /* Choose the most frequently found color as background. */
7825 for (i
= best_count
= 0; i
< 4; ++i
)
7829 for (j
= n
= 0; j
< 4; ++j
)
7830 if (corners
[i
] == corners
[j
])
7834 bg
= corners
[i
], best_count
= n
;
7838 /* Set all bits in mask_img to 1 whose color in ximg is different
7839 from the background color bg. */
7840 for (y
= 0; y
< img
->height
; ++y
)
7841 for (x
= 0; x
< img
->width
; ++x
)
7842 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7844 /* Put mask_img into img->mask. */
7845 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7846 x_destroy_x_image (mask_img
);
7847 XDestroyImage (ximg
);
7854 /***********************************************************************
7855 PBM (mono, gray, color)
7856 ***********************************************************************/
7858 static int pbm_image_p
P_ ((Lisp_Object object
));
7859 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7860 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7862 /* The symbol `pbm' identifying images of this type. */
7866 /* Indices of image specification fields in gs_format, below. */
7868 enum pbm_keyword_index
7882 /* Vector of image_keyword structures describing the format
7883 of valid user-defined image specifications. */
7885 static struct image_keyword pbm_format
[PBM_LAST
] =
7887 {":type", IMAGE_SYMBOL_VALUE
, 1},
7888 {":file", IMAGE_STRING_VALUE
, 0},
7889 {":data", IMAGE_STRING_VALUE
, 0},
7890 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7891 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7892 {":relief", IMAGE_INTEGER_VALUE
, 0},
7893 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7894 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7895 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7898 /* Structure describing the image type `pbm'. */
7900 static struct image_type pbm_type
=
7910 /* Return non-zero if OBJECT is a valid PBM image specification. */
7913 pbm_image_p (object
)
7916 struct image_keyword fmt
[PBM_LAST
];
7918 bcopy (pbm_format
, fmt
, sizeof fmt
);
7920 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7923 /* Must specify either :data or :file. */
7924 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7928 /* Scan a decimal number from *S and return it. Advance *S while
7929 reading the number. END is the end of the string. Value is -1 at
7933 pbm_scan_number (s
, end
)
7934 unsigned char **s
, *end
;
7936 int c
= 0, val
= -1;
7940 /* Skip white-space. */
7941 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7946 /* Skip comment to end of line. */
7947 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7950 else if (isdigit (c
))
7952 /* Read decimal number. */
7954 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7955 val
= 10 * val
+ c
- '0';
7966 /* Load PBM image IMG for use on frame F. */
7974 int width
, height
, max_color_idx
= 0;
7976 Lisp_Object file
, specified_file
;
7977 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7978 struct gcpro gcpro1
;
7979 unsigned char *contents
= NULL
;
7980 unsigned char *end
, *p
;
7983 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7987 if (STRINGP (specified_file
))
7989 file
= x_find_image_file (specified_file
);
7990 if (!STRINGP (file
))
7992 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7997 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7998 if (contents
== NULL
)
8000 image_error ("Error reading `%s'", file
, Qnil
);
8006 end
= contents
+ size
;
8011 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8012 p
= XSTRING (data
)->data
;
8013 end
= p
+ STRING_BYTES (XSTRING (data
));
8016 /* Check magic number. */
8017 if (end
- p
< 2 || *p
++ != 'P')
8019 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8029 raw_p
= 0, type
= PBM_MONO
;
8033 raw_p
= 0, type
= PBM_GRAY
;
8037 raw_p
= 0, type
= PBM_COLOR
;
8041 raw_p
= 1, type
= PBM_MONO
;
8045 raw_p
= 1, type
= PBM_GRAY
;
8049 raw_p
= 1, type
= PBM_COLOR
;
8053 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8057 /* Read width, height, maximum color-component. Characters
8058 starting with `#' up to the end of a line are ignored. */
8059 width
= pbm_scan_number (&p
, end
);
8060 height
= pbm_scan_number (&p
, end
);
8062 if (type
!= PBM_MONO
)
8064 max_color_idx
= pbm_scan_number (&p
, end
);
8065 if (raw_p
&& max_color_idx
> 255)
8066 max_color_idx
= 255;
8071 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8074 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8075 &ximg
, &img
->pixmap
))
8078 /* Initialize the color hash table. */
8079 init_color_table ();
8081 if (type
== PBM_MONO
)
8085 for (y
= 0; y
< height
; ++y
)
8086 for (x
= 0; x
< width
; ++x
)
8096 g
= pbm_scan_number (&p
, end
);
8098 XPutPixel (ximg
, x
, y
, (g
8099 ? FRAME_FOREGROUND_PIXEL (f
)
8100 : FRAME_BACKGROUND_PIXEL (f
)));
8105 for (y
= 0; y
< height
; ++y
)
8106 for (x
= 0; x
< width
; ++x
)
8110 if (type
== PBM_GRAY
)
8111 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8120 r
= pbm_scan_number (&p
, end
);
8121 g
= pbm_scan_number (&p
, end
);
8122 b
= pbm_scan_number (&p
, end
);
8125 if (r
< 0 || g
< 0 || b
< 0)
8129 XDestroyImage (ximg
);
8130 image_error ("Invalid pixel value in image `%s'",
8135 /* RGB values are now in the range 0..max_color_idx.
8136 Scale this to the range 0..0xffff supported by X. */
8137 r
= (double) r
* 65535 / max_color_idx
;
8138 g
= (double) g
* 65535 / max_color_idx
;
8139 b
= (double) b
* 65535 / max_color_idx
;
8140 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8144 /* Store in IMG->colors the colors allocated for the image, and
8145 free the color table. */
8146 img
->colors
= colors_in_color_table (&img
->ncolors
);
8147 free_color_table ();
8149 /* Put the image into a pixmap. */
8150 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8151 x_destroy_x_image (ximg
);
8154 img
->height
= height
;
8163 /***********************************************************************
8165 ***********************************************************************/
8171 /* Function prototypes. */
8173 static int png_image_p
P_ ((Lisp_Object object
));
8174 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8176 /* The symbol `png' identifying images of this type. */
8180 /* Indices of image specification fields in png_format, below. */
8182 enum png_keyword_index
8196 /* Vector of image_keyword structures describing the format
8197 of valid user-defined image specifications. */
8199 static struct image_keyword png_format
[PNG_LAST
] =
8201 {":type", IMAGE_SYMBOL_VALUE
, 1},
8202 {":data", IMAGE_STRING_VALUE
, 0},
8203 {":file", IMAGE_STRING_VALUE
, 0},
8204 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8205 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8206 {":relief", IMAGE_INTEGER_VALUE
, 0},
8207 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8208 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8209 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8212 /* Structure describing the image type `png'. */
8214 static struct image_type png_type
=
8224 /* Return non-zero if OBJECT is a valid PNG image specification. */
8227 png_image_p (object
)
8230 struct image_keyword fmt
[PNG_LAST
];
8231 bcopy (png_format
, fmt
, sizeof fmt
);
8233 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8236 /* Must specify either the :data or :file keyword. */
8237 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8241 /* Error and warning handlers installed when the PNG library
8245 my_png_error (png_ptr
, msg
)
8246 png_struct
*png_ptr
;
8249 xassert (png_ptr
!= NULL
);
8250 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8251 longjmp (png_ptr
->jmpbuf
, 1);
8256 my_png_warning (png_ptr
, msg
)
8257 png_struct
*png_ptr
;
8260 xassert (png_ptr
!= NULL
);
8261 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8264 /* Memory source for PNG decoding. */
8266 struct png_memory_storage
8268 unsigned char *bytes
; /* The data */
8269 size_t len
; /* How big is it? */
8270 int index
; /* Where are we? */
8274 /* Function set as reader function when reading PNG image from memory.
8275 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8276 bytes from the input to DATA. */
8279 png_read_from_memory (png_ptr
, data
, length
)
8280 png_structp png_ptr
;
8284 struct png_memory_storage
*tbr
8285 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8287 if (length
> tbr
->len
- tbr
->index
)
8288 png_error (png_ptr
, "Read error");
8290 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8291 tbr
->index
= tbr
->index
+ length
;
8294 /* Load PNG image IMG for use on frame F. Value is non-zero if
8302 Lisp_Object file
, specified_file
;
8303 Lisp_Object specified_data
;
8305 XImage
*ximg
, *mask_img
= NULL
;
8306 struct gcpro gcpro1
;
8307 png_struct
*png_ptr
= NULL
;
8308 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8309 FILE *volatile fp
= NULL
;
8311 png_byte
* volatile pixels
= NULL
;
8312 png_byte
** volatile rows
= NULL
;
8313 png_uint_32 width
, height
;
8314 int bit_depth
, color_type
, interlace_type
;
8316 png_uint_32 row_bytes
;
8319 double screen_gamma
, image_gamma
;
8321 struct png_memory_storage tbr
; /* Data to be read */
8323 /* Find out what file to load. */
8324 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8325 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8329 if (NILP (specified_data
))
8331 file
= x_find_image_file (specified_file
);
8332 if (!STRINGP (file
))
8334 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8339 /* Open the image file. */
8340 fp
= fopen (XSTRING (file
)->data
, "rb");
8343 image_error ("Cannot open image file `%s'", file
, Qnil
);
8349 /* Check PNG signature. */
8350 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8351 || !png_check_sig (sig
, sizeof sig
))
8353 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8361 /* Read from memory. */
8362 tbr
.bytes
= XSTRING (specified_data
)->data
;
8363 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8366 /* Check PNG signature. */
8367 if (tbr
.len
< sizeof sig
8368 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8370 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8375 /* Need to skip past the signature. */
8376 tbr
.bytes
+= sizeof (sig
);
8379 /* Initialize read and info structs for PNG lib. */
8380 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8381 my_png_error
, my_png_warning
);
8384 if (fp
) fclose (fp
);
8389 info_ptr
= png_create_info_struct (png_ptr
);
8392 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8393 if (fp
) fclose (fp
);
8398 end_info
= png_create_info_struct (png_ptr
);
8401 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8402 if (fp
) fclose (fp
);
8407 /* Set error jump-back. We come back here when the PNG library
8408 detects an error. */
8409 if (setjmp (png_ptr
->jmpbuf
))
8413 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8416 if (fp
) fclose (fp
);
8421 /* Read image info. */
8422 if (!NILP (specified_data
))
8423 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8425 png_init_io (png_ptr
, fp
);
8427 png_set_sig_bytes (png_ptr
, sizeof sig
);
8428 png_read_info (png_ptr
, info_ptr
);
8429 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8430 &interlace_type
, NULL
, NULL
);
8432 /* If image contains simply transparency data, we prefer to
8433 construct a clipping mask. */
8434 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8439 /* This function is easier to write if we only have to handle
8440 one data format: RGB or RGBA with 8 bits per channel. Let's
8441 transform other formats into that format. */
8443 /* Strip more than 8 bits per channel. */
8444 if (bit_depth
== 16)
8445 png_set_strip_16 (png_ptr
);
8447 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8449 png_set_expand (png_ptr
);
8451 /* Convert grayscale images to RGB. */
8452 if (color_type
== PNG_COLOR_TYPE_GRAY
8453 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8454 png_set_gray_to_rgb (png_ptr
);
8456 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8457 gamma_str
= getenv ("SCREEN_GAMMA");
8458 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8460 /* Tell the PNG lib to handle gamma correction for us. */
8462 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8463 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8464 /* There is a special chunk in the image specifying the gamma. */
8465 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8468 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8469 /* Image contains gamma information. */
8470 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8472 /* Use a default of 0.5 for the image gamma. */
8473 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8475 /* Handle alpha channel by combining the image with a background
8476 color. Do this only if a real alpha channel is supplied. For
8477 simple transparency, we prefer a clipping mask. */
8480 png_color_16
*image_background
;
8482 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8483 /* Image contains a background color with which to
8484 combine the image. */
8485 png_set_background (png_ptr
, image_background
,
8486 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8489 /* Image does not contain a background color with which
8490 to combine the image data via an alpha channel. Use
8491 the frame's background instead. */
8494 png_color_16 frame_background
;
8496 cmap
= FRAME_X_COLORMAP (f
);
8497 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8498 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8500 bzero (&frame_background
, sizeof frame_background
);
8501 frame_background
.red
= color
.red
;
8502 frame_background
.green
= color
.green
;
8503 frame_background
.blue
= color
.blue
;
8505 png_set_background (png_ptr
, &frame_background
,
8506 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8510 /* Update info structure. */
8511 png_read_update_info (png_ptr
, info_ptr
);
8513 /* Get number of channels. Valid values are 1 for grayscale images
8514 and images with a palette, 2 for grayscale images with transparency
8515 information (alpha channel), 3 for RGB images, and 4 for RGB
8516 images with alpha channel, i.e. RGBA. If conversions above were
8517 sufficient we should only have 3 or 4 channels here. */
8518 channels
= png_get_channels (png_ptr
, info_ptr
);
8519 xassert (channels
== 3 || channels
== 4);
8521 /* Number of bytes needed for one row of the image. */
8522 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8524 /* Allocate memory for the image. */
8525 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8526 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8527 for (i
= 0; i
< height
; ++i
)
8528 rows
[i
] = pixels
+ i
* row_bytes
;
8530 /* Read the entire image. */
8531 png_read_image (png_ptr
, rows
);
8532 png_read_end (png_ptr
, info_ptr
);
8539 /* Create the X image and pixmap. */
8540 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8544 /* Create an image and pixmap serving as mask if the PNG image
8545 contains an alpha channel. */
8548 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8549 &mask_img
, &img
->mask
))
8551 x_destroy_x_image (ximg
);
8552 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8557 /* Fill the X image and mask from PNG data. */
8558 init_color_table ();
8560 for (y
= 0; y
< height
; ++y
)
8562 png_byte
*p
= rows
[y
];
8564 for (x
= 0; x
< width
; ++x
)
8571 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8573 /* An alpha channel, aka mask channel, associates variable
8574 transparency with an image. Where other image formats
8575 support binary transparency---fully transparent or fully
8576 opaque---PNG allows up to 254 levels of partial transparency.
8577 The PNG library implements partial transparency by combining
8578 the image with a specified background color.
8580 I'm not sure how to handle this here nicely: because the
8581 background on which the image is displayed may change, for
8582 real alpha channel support, it would be necessary to create
8583 a new image for each possible background.
8585 What I'm doing now is that a mask is created if we have
8586 boolean transparency information. Otherwise I'm using
8587 the frame's background color to combine the image with. */
8592 XPutPixel (mask_img
, x
, y
, *p
> 0);
8598 /* Remember colors allocated for this image. */
8599 img
->colors
= colors_in_color_table (&img
->ncolors
);
8600 free_color_table ();
8603 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8608 img
->height
= height
;
8610 /* Put the image into the pixmap, then free the X image and its buffer. */
8611 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8612 x_destroy_x_image (ximg
);
8614 /* Same for the mask. */
8617 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8618 x_destroy_x_image (mask_img
);
8625 #endif /* HAVE_PNG != 0 */
8629 /***********************************************************************
8631 ***********************************************************************/
8635 /* Work around a warning about HAVE_STDLIB_H being redefined in
8637 #ifdef HAVE_STDLIB_H
8638 #define HAVE_STDLIB_H_1
8639 #undef HAVE_STDLIB_H
8640 #endif /* HAVE_STLIB_H */
8642 #include <jpeglib.h>
8646 #ifdef HAVE_STLIB_H_1
8647 #define HAVE_STDLIB_H 1
8650 static int jpeg_image_p
P_ ((Lisp_Object object
));
8651 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8653 /* The symbol `jpeg' identifying images of this type. */
8657 /* Indices of image specification fields in gs_format, below. */
8659 enum jpeg_keyword_index
8668 JPEG_HEURISTIC_MASK
,
8673 /* Vector of image_keyword structures describing the format
8674 of valid user-defined image specifications. */
8676 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8678 {":type", IMAGE_SYMBOL_VALUE
, 1},
8679 {":data", IMAGE_STRING_VALUE
, 0},
8680 {":file", IMAGE_STRING_VALUE
, 0},
8681 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8682 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8683 {":relief", IMAGE_INTEGER_VALUE
, 0},
8684 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8685 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8686 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8689 /* Structure describing the image type `jpeg'. */
8691 static struct image_type jpeg_type
=
8701 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8704 jpeg_image_p (object
)
8707 struct image_keyword fmt
[JPEG_LAST
];
8709 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8711 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8714 /* Must specify either the :data or :file keyword. */
8715 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8719 struct my_jpeg_error_mgr
8721 struct jpeg_error_mgr pub
;
8722 jmp_buf setjmp_buffer
;
8727 my_error_exit (cinfo
)
8730 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8731 longjmp (mgr
->setjmp_buffer
, 1);
8735 /* Init source method for JPEG data source manager. Called by
8736 jpeg_read_header() before any data is actually read. See
8737 libjpeg.doc from the JPEG lib distribution. */
8740 our_init_source (cinfo
)
8741 j_decompress_ptr cinfo
;
8746 /* Fill input buffer method for JPEG data source manager. Called
8747 whenever more data is needed. We read the whole image in one step,
8748 so this only adds a fake end of input marker at the end. */
8751 our_fill_input_buffer (cinfo
)
8752 j_decompress_ptr cinfo
;
8754 /* Insert a fake EOI marker. */
8755 struct jpeg_source_mgr
*src
= cinfo
->src
;
8756 static JOCTET buffer
[2];
8758 buffer
[0] = (JOCTET
) 0xFF;
8759 buffer
[1] = (JOCTET
) JPEG_EOI
;
8761 src
->next_input_byte
= buffer
;
8762 src
->bytes_in_buffer
= 2;
8767 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8768 is the JPEG data source manager. */
8771 our_skip_input_data (cinfo
, num_bytes
)
8772 j_decompress_ptr cinfo
;
8775 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8779 if (num_bytes
> src
->bytes_in_buffer
)
8780 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8782 src
->bytes_in_buffer
-= num_bytes
;
8783 src
->next_input_byte
+= num_bytes
;
8788 /* Method to terminate data source. Called by
8789 jpeg_finish_decompress() after all data has been processed. */
8792 our_term_source (cinfo
)
8793 j_decompress_ptr cinfo
;
8798 /* Set up the JPEG lib for reading an image from DATA which contains
8799 LEN bytes. CINFO is the decompression info structure created for
8800 reading the image. */
8803 jpeg_memory_src (cinfo
, data
, len
)
8804 j_decompress_ptr cinfo
;
8808 struct jpeg_source_mgr
*src
;
8810 if (cinfo
->src
== NULL
)
8812 /* First time for this JPEG object? */
8813 cinfo
->src
= (struct jpeg_source_mgr
*)
8814 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8815 sizeof (struct jpeg_source_mgr
));
8816 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8817 src
->next_input_byte
= data
;
8820 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8821 src
->init_source
= our_init_source
;
8822 src
->fill_input_buffer
= our_fill_input_buffer
;
8823 src
->skip_input_data
= our_skip_input_data
;
8824 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8825 src
->term_source
= our_term_source
;
8826 src
->bytes_in_buffer
= len
;
8827 src
->next_input_byte
= data
;
8831 /* Load image IMG for use on frame F. Patterned after example.c
8832 from the JPEG lib. */
8839 struct jpeg_decompress_struct cinfo
;
8840 struct my_jpeg_error_mgr mgr
;
8841 Lisp_Object file
, specified_file
;
8842 Lisp_Object specified_data
;
8843 FILE * volatile fp
= NULL
;
8845 int row_stride
, x
, y
;
8846 XImage
*ximg
= NULL
;
8848 unsigned long *colors
;
8850 struct gcpro gcpro1
;
8852 /* Open the JPEG file. */
8853 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8854 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8858 if (NILP (specified_data
))
8860 file
= x_find_image_file (specified_file
);
8861 if (!STRINGP (file
))
8863 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8868 fp
= fopen (XSTRING (file
)->data
, "r");
8871 image_error ("Cannot open `%s'", file
, Qnil
);
8877 /* Customize libjpeg's error handling to call my_error_exit when an
8878 error is detected. This function will perform a longjmp. */
8879 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8880 mgr
.pub
.error_exit
= my_error_exit
;
8882 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8886 /* Called from my_error_exit. Display a JPEG error. */
8887 char buffer
[JMSG_LENGTH_MAX
];
8888 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8889 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8890 build_string (buffer
));
8893 /* Close the input file and destroy the JPEG object. */
8895 fclose ((FILE *) fp
);
8896 jpeg_destroy_decompress (&cinfo
);
8898 /* If we already have an XImage, free that. */
8899 x_destroy_x_image (ximg
);
8901 /* Free pixmap and colors. */
8902 x_clear_image (f
, img
);
8908 /* Create the JPEG decompression object. Let it read from fp.
8909 Read the JPEG image header. */
8910 jpeg_create_decompress (&cinfo
);
8912 if (NILP (specified_data
))
8913 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
8915 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8916 STRING_BYTES (XSTRING (specified_data
)));
8918 jpeg_read_header (&cinfo
, TRUE
);
8920 /* Customize decompression so that color quantization will be used.
8921 Start decompression. */
8922 cinfo
.quantize_colors
= TRUE
;
8923 jpeg_start_decompress (&cinfo
);
8924 width
= img
->width
= cinfo
.output_width
;
8925 height
= img
->height
= cinfo
.output_height
;
8927 /* Create X image and pixmap. */
8928 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8929 longjmp (mgr
.setjmp_buffer
, 2);
8931 /* Allocate colors. When color quantization is used,
8932 cinfo.actual_number_of_colors has been set with the number of
8933 colors generated, and cinfo.colormap is a two-dimensional array
8934 of color indices in the range 0..cinfo.actual_number_of_colors.
8935 No more than 255 colors will be generated. */
8939 if (cinfo
.out_color_components
> 2)
8940 ir
= 0, ig
= 1, ib
= 2;
8941 else if (cinfo
.out_color_components
> 1)
8942 ir
= 0, ig
= 1, ib
= 0;
8944 ir
= 0, ig
= 0, ib
= 0;
8946 /* Use the color table mechanism because it handles colors that
8947 cannot be allocated nicely. Such colors will be replaced with
8948 a default color, and we don't have to care about which colors
8949 can be freed safely, and which can't. */
8950 init_color_table ();
8951 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8954 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8956 /* Multiply RGB values with 255 because X expects RGB values
8957 in the range 0..0xffff. */
8958 int r
= cinfo
.colormap
[ir
][i
] << 8;
8959 int g
= cinfo
.colormap
[ig
][i
] << 8;
8960 int b
= cinfo
.colormap
[ib
][i
] << 8;
8961 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8964 /* Remember those colors actually allocated. */
8965 img
->colors
= colors_in_color_table (&img
->ncolors
);
8966 free_color_table ();
8970 row_stride
= width
* cinfo
.output_components
;
8971 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8973 for (y
= 0; y
< height
; ++y
)
8975 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8976 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8977 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8981 jpeg_finish_decompress (&cinfo
);
8982 jpeg_destroy_decompress (&cinfo
);
8984 fclose ((FILE *) fp
);
8986 /* Put the image into the pixmap. */
8987 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8988 x_destroy_x_image (ximg
);
8993 #endif /* HAVE_JPEG */
8997 /***********************************************************************
8999 ***********************************************************************/
9005 static int tiff_image_p
P_ ((Lisp_Object object
));
9006 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9008 /* The symbol `tiff' identifying images of this type. */
9012 /* Indices of image specification fields in tiff_format, below. */
9014 enum tiff_keyword_index
9023 TIFF_HEURISTIC_MASK
,
9028 /* Vector of image_keyword structures describing the format
9029 of valid user-defined image specifications. */
9031 static struct image_keyword tiff_format
[TIFF_LAST
] =
9033 {":type", IMAGE_SYMBOL_VALUE
, 1},
9034 {":data", IMAGE_STRING_VALUE
, 0},
9035 {":file", IMAGE_STRING_VALUE
, 0},
9036 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9037 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9038 {":relief", IMAGE_INTEGER_VALUE
, 0},
9039 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9040 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9041 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9044 /* Structure describing the image type `tiff'. */
9046 static struct image_type tiff_type
=
9056 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9059 tiff_image_p (object
)
9062 struct image_keyword fmt
[TIFF_LAST
];
9063 bcopy (tiff_format
, fmt
, sizeof fmt
);
9065 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9068 /* Must specify either the :data or :file keyword. */
9069 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9073 /* Reading from a memory buffer for TIFF images Based on the PNG
9074 memory source, but we have to provide a lot of extra functions.
9077 We really only need to implement read and seek, but I am not
9078 convinced that the TIFF library is smart enough not to destroy
9079 itself if we only hand it the function pointers we need to
9084 unsigned char *bytes
;
9092 tiff_read_from_memory (data
, buf
, size
)
9097 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9099 if (size
> src
->len
- src
->index
)
9101 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9108 tiff_write_from_memory (data
, buf
, size
)
9118 tiff_seek_in_memory (data
, off
, whence
)
9123 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9128 case SEEK_SET
: /* Go from beginning of source. */
9132 case SEEK_END
: /* Go from end of source. */
9133 idx
= src
->len
+ off
;
9136 case SEEK_CUR
: /* Go from current position. */
9137 idx
= src
->index
+ off
;
9140 default: /* Invalid `whence'. */
9144 if (idx
> src
->len
|| idx
< 0)
9153 tiff_close_memory (data
)
9162 tiff_mmap_memory (data
, pbase
, psize
)
9167 /* It is already _IN_ memory. */
9173 tiff_unmap_memory (data
, base
, size
)
9178 /* We don't need to do this. */
9183 tiff_size_of_memory (data
)
9186 return ((tiff_memory_source
*) data
)->len
;
9190 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9198 Lisp_Object file
, specified_file
;
9199 Lisp_Object specified_data
;
9201 int width
, height
, x
, y
;
9205 struct gcpro gcpro1
;
9206 tiff_memory_source memsrc
;
9208 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9209 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9213 if (NILP (specified_data
))
9215 /* Read from a file */
9216 file
= x_find_image_file (specified_file
);
9217 if (!STRINGP (file
))
9219 image_error ("Cannot find image file `%s'", file
, Qnil
);
9224 /* Try to open the image file. */
9225 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9228 image_error ("Cannot open `%s'", file
, Qnil
);
9235 /* Memory source! */
9236 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9237 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9240 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9241 (TIFFReadWriteProc
) tiff_read_from_memory
,
9242 (TIFFReadWriteProc
) tiff_write_from_memory
,
9243 tiff_seek_in_memory
,
9245 tiff_size_of_memory
,
9251 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9257 /* Get width and height of the image, and allocate a raster buffer
9258 of width x height 32-bit values. */
9259 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9260 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9261 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9263 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9267 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9273 /* Create the X image and pixmap. */
9274 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9281 /* Initialize the color table. */
9282 init_color_table ();
9284 /* Process the pixel raster. Origin is in the lower-left corner. */
9285 for (y
= 0; y
< height
; ++y
)
9287 uint32
*row
= buf
+ y
* width
;
9289 for (x
= 0; x
< width
; ++x
)
9291 uint32 abgr
= row
[x
];
9292 int r
= TIFFGetR (abgr
) << 8;
9293 int g
= TIFFGetG (abgr
) << 8;
9294 int b
= TIFFGetB (abgr
) << 8;
9295 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9299 /* Remember the colors allocated for the image. Free the color table. */
9300 img
->colors
= colors_in_color_table (&img
->ncolors
);
9301 free_color_table ();
9303 /* Put the image into the pixmap, then free the X image and its buffer. */
9304 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9305 x_destroy_x_image (ximg
);
9309 img
->height
= height
;
9315 #endif /* HAVE_TIFF != 0 */
9319 /***********************************************************************
9321 ***********************************************************************/
9325 #include <gif_lib.h>
9327 static int gif_image_p
P_ ((Lisp_Object object
));
9328 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9330 /* The symbol `gif' identifying images of this type. */
9334 /* Indices of image specification fields in gif_format, below. */
9336 enum gif_keyword_index
9351 /* Vector of image_keyword structures describing the format
9352 of valid user-defined image specifications. */
9354 static struct image_keyword gif_format
[GIF_LAST
] =
9356 {":type", IMAGE_SYMBOL_VALUE
, 1},
9357 {":data", IMAGE_STRING_VALUE
, 0},
9358 {":file", IMAGE_STRING_VALUE
, 0},
9359 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9360 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9361 {":relief", IMAGE_INTEGER_VALUE
, 0},
9362 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9363 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9364 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9365 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9368 /* Structure describing the image type `gif'. */
9370 static struct image_type gif_type
=
9380 /* Return non-zero if OBJECT is a valid GIF image specification. */
9383 gif_image_p (object
)
9386 struct image_keyword fmt
[GIF_LAST
];
9387 bcopy (gif_format
, fmt
, sizeof fmt
);
9389 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9392 /* Must specify either the :data or :file keyword. */
9393 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9397 /* Reading a GIF image from memory
9398 Based on the PNG memory stuff to a certain extent. */
9402 unsigned char *bytes
;
9409 /* Make the current memory source available to gif_read_from_memory.
9410 It's done this way because not all versions of libungif support
9411 a UserData field in the GifFileType structure. */
9412 static gif_memory_source
*current_gif_memory_src
;
9415 gif_read_from_memory (file
, buf
, len
)
9420 gif_memory_source
*src
= current_gif_memory_src
;
9422 if (len
> src
->len
- src
->index
)
9425 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9431 /* Load GIF image IMG for use on frame F. Value is non-zero if
9439 Lisp_Object file
, specified_file
;
9440 Lisp_Object specified_data
;
9441 int rc
, width
, height
, x
, y
, i
;
9443 ColorMapObject
*gif_color_map
;
9444 unsigned long pixel_colors
[256];
9446 struct gcpro gcpro1
;
9448 int ino
, image_left
, image_top
, image_width
, image_height
;
9449 gif_memory_source memsrc
;
9450 unsigned char *raster
;
9452 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9453 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9457 if (NILP (specified_data
))
9459 file
= x_find_image_file (specified_file
);
9460 if (!STRINGP (file
))
9462 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9467 /* Open the GIF file. */
9468 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9471 image_error ("Cannot open `%s'", file
, Qnil
);
9478 /* Read from memory! */
9479 current_gif_memory_src
= &memsrc
;
9480 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9481 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9484 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9487 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9493 /* Read entire contents. */
9494 rc
= DGifSlurp (gif
);
9495 if (rc
== GIF_ERROR
)
9497 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9498 DGifCloseFile (gif
);
9503 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9504 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9505 if (ino
>= gif
->ImageCount
)
9507 image_error ("Invalid image number `%s' in image `%s'",
9509 DGifCloseFile (gif
);
9514 width
= img
->width
= gif
->SWidth
;
9515 height
= img
->height
= gif
->SHeight
;
9517 /* Create the X image and pixmap. */
9518 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9520 DGifCloseFile (gif
);
9525 /* Allocate colors. */
9526 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9528 gif_color_map
= gif
->SColorMap
;
9529 init_color_table ();
9530 bzero (pixel_colors
, sizeof pixel_colors
);
9532 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9534 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9535 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9536 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9537 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9540 img
->colors
= colors_in_color_table (&img
->ncolors
);
9541 free_color_table ();
9543 /* Clear the part of the screen image that are not covered by
9544 the image from the GIF file. Full animated GIF support
9545 requires more than can be done here (see the gif89 spec,
9546 disposal methods). Let's simply assume that the part
9547 not covered by a sub-image is in the frame's background color. */
9548 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9549 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9550 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9551 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9553 for (y
= 0; y
< image_top
; ++y
)
9554 for (x
= 0; x
< width
; ++x
)
9555 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9557 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9558 for (x
= 0; x
< width
; ++x
)
9559 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9561 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9563 for (x
= 0; x
< image_left
; ++x
)
9564 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9565 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9566 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9569 /* Read the GIF image into the X image. We use a local variable
9570 `raster' here because RasterBits below is a char *, and invites
9571 problems with bytes >= 0x80. */
9572 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9574 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9576 static int interlace_start
[] = {0, 4, 2, 1};
9577 static int interlace_increment
[] = {8, 8, 4, 2};
9579 int row
= interlace_start
[0];
9583 for (y
= 0; y
< image_height
; y
++)
9585 if (row
>= image_height
)
9587 row
= interlace_start
[++pass
];
9588 while (row
>= image_height
)
9589 row
= interlace_start
[++pass
];
9592 for (x
= 0; x
< image_width
; x
++)
9594 int i
= raster
[(y
* image_width
) + x
];
9595 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9599 row
+= interlace_increment
[pass
];
9604 for (y
= 0; y
< image_height
; ++y
)
9605 for (x
= 0; x
< image_width
; ++x
)
9607 int i
= raster
[y
* image_width
+ x
];
9608 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9612 DGifCloseFile (gif
);
9614 /* Put the image into the pixmap, then free the X image and its buffer. */
9615 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9616 x_destroy_x_image (ximg
);
9622 #endif /* HAVE_GIF != 0 */
9626 /***********************************************************************
9628 ***********************************************************************/
9630 static int gs_image_p
P_ ((Lisp_Object object
));
9631 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9632 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9634 /* The symbol `postscript' identifying images of this type. */
9636 Lisp_Object Qpostscript
;
9638 /* Keyword symbols. */
9640 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9642 /* Indices of image specification fields in gs_format, below. */
9644 enum gs_keyword_index
9661 /* Vector of image_keyword structures describing the format
9662 of valid user-defined image specifications. */
9664 static struct image_keyword gs_format
[GS_LAST
] =
9666 {":type", IMAGE_SYMBOL_VALUE
, 1},
9667 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9668 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9669 {":file", IMAGE_STRING_VALUE
, 1},
9670 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9671 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9672 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9673 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9674 {":relief", IMAGE_INTEGER_VALUE
, 0},
9675 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9676 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9677 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9680 /* Structure describing the image type `ghostscript'. */
9682 static struct image_type gs_type
=
9692 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9695 gs_clear_image (f
, img
)
9699 /* IMG->data.ptr_val may contain a recorded colormap. */
9700 xfree (img
->data
.ptr_val
);
9701 x_clear_image (f
, img
);
9705 /* Return non-zero if OBJECT is a valid Ghostscript image
9712 struct image_keyword fmt
[GS_LAST
];
9716 bcopy (gs_format
, fmt
, sizeof fmt
);
9718 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9721 /* Bounding box must be a list or vector containing 4 integers. */
9722 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9725 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9726 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9731 else if (VECTORP (tem
))
9733 if (XVECTOR (tem
)->size
!= 4)
9735 for (i
= 0; i
< 4; ++i
)
9736 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9746 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9755 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9756 struct gcpro gcpro1
, gcpro2
;
9758 double in_width
, in_height
;
9759 Lisp_Object pixel_colors
= Qnil
;
9761 /* Compute pixel size of pixmap needed from the given size in the
9762 image specification. Sizes in the specification are in pt. 1 pt
9763 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9765 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9766 in_width
= XFASTINT (pt_width
) / 72.0;
9767 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9768 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9769 in_height
= XFASTINT (pt_height
) / 72.0;
9770 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9772 /* Create the pixmap. */
9773 xassert (img
->pixmap
== None
);
9774 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9775 img
->width
, img
->height
,
9776 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9780 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9784 /* Call the loader to fill the pixmap. It returns a process object
9785 if successful. We do not record_unwind_protect here because
9786 other places in redisplay like calling window scroll functions
9787 don't either. Let the Lisp loader use `unwind-protect' instead. */
9788 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9790 sprintf (buffer
, "%lu %lu",
9791 (unsigned long) FRAME_X_WINDOW (f
),
9792 (unsigned long) img
->pixmap
);
9793 window_and_pixmap_id
= build_string (buffer
);
9795 sprintf (buffer
, "%lu %lu",
9796 FRAME_FOREGROUND_PIXEL (f
),
9797 FRAME_BACKGROUND_PIXEL (f
));
9798 pixel_colors
= build_string (buffer
);
9800 XSETFRAME (frame
, f
);
9801 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9803 loader
= intern ("gs-load-image");
9805 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9806 make_number (img
->width
),
9807 make_number (img
->height
),
9808 window_and_pixmap_id
,
9811 return PROCESSP (img
->data
.lisp_val
);
9815 /* Kill the Ghostscript process that was started to fill PIXMAP on
9816 frame F. Called from XTread_socket when receiving an event
9817 telling Emacs that Ghostscript has finished drawing. */
9820 x_kill_gs_process (pixmap
, f
)
9824 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9828 /* Find the image containing PIXMAP. */
9829 for (i
= 0; i
< c
->used
; ++i
)
9830 if (c
->images
[i
]->pixmap
== pixmap
)
9833 /* Kill the GS process. We should have found PIXMAP in the image
9834 cache and its image should contain a process object. */
9835 xassert (i
< c
->used
);
9837 xassert (PROCESSP (img
->data
.lisp_val
));
9838 Fkill_process (img
->data
.lisp_val
, Qnil
);
9839 img
->data
.lisp_val
= Qnil
;
9841 /* On displays with a mutable colormap, figure out the colors
9842 allocated for the image by looking at the pixels of an XImage for
9844 class = FRAME_X_VISUAL (f
)->class;
9845 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9851 /* Try to get an XImage for img->pixmep. */
9852 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9853 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9858 /* Initialize the color table. */
9859 init_color_table ();
9861 /* For each pixel of the image, look its color up in the
9862 color table. After having done so, the color table will
9863 contain an entry for each color used by the image. */
9864 for (y
= 0; y
< img
->height
; ++y
)
9865 for (x
= 0; x
< img
->width
; ++x
)
9867 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9868 lookup_pixel_color (f
, pixel
);
9871 /* Record colors in the image. Free color table and XImage. */
9872 img
->colors
= colors_in_color_table (&img
->ncolors
);
9873 free_color_table ();
9874 XDestroyImage (ximg
);
9876 #if 0 /* This doesn't seem to be the case. If we free the colors
9877 here, we get a BadAccess later in x_clear_image when
9878 freeing the colors. */
9879 /* We have allocated colors once, but Ghostscript has also
9880 allocated colors on behalf of us. So, to get the
9881 reference counts right, free them once. */
9883 x_free_colors (f
, img
->colors
, img
->ncolors
);
9887 image_error ("Cannot get X image of `%s'; colors will not be freed",
9896 /***********************************************************************
9898 ***********************************************************************/
9900 DEFUN ("x-change-window-property", Fx_change_window_property
,
9901 Sx_change_window_property
, 2, 3, 0,
9902 "Change window property PROP to VALUE on the X window of FRAME.\n\
9903 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9904 selected frame. Value is VALUE.")
9905 (prop
, value
, frame
)
9906 Lisp_Object frame
, prop
, value
;
9908 struct frame
*f
= check_x_frame (frame
);
9911 CHECK_STRING (prop
, 1);
9912 CHECK_STRING (value
, 2);
9915 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9916 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9917 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9918 XSTRING (value
)->data
, XSTRING (value
)->size
);
9920 /* Make sure the property is set when we return. */
9921 XFlush (FRAME_X_DISPLAY (f
));
9928 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9929 Sx_delete_window_property
, 1, 2, 0,
9930 "Remove window property PROP from X window of FRAME.\n\
9931 FRAME nil or omitted means use the selected frame. Value is PROP.")
9933 Lisp_Object prop
, frame
;
9935 struct frame
*f
= check_x_frame (frame
);
9938 CHECK_STRING (prop
, 1);
9940 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9941 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9943 /* Make sure the property is removed when we return. */
9944 XFlush (FRAME_X_DISPLAY (f
));
9951 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9953 "Value is the value of window property PROP on FRAME.\n\
9954 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9955 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9958 Lisp_Object prop
, frame
;
9960 struct frame
*f
= check_x_frame (frame
);
9963 Lisp_Object prop_value
= Qnil
;
9964 char *tmp_data
= NULL
;
9967 unsigned long actual_size
, bytes_remaining
;
9969 CHECK_STRING (prop
, 1);
9971 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9972 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9973 prop_atom
, 0, 0, False
, XA_STRING
,
9974 &actual_type
, &actual_format
, &actual_size
,
9975 &bytes_remaining
, (unsigned char **) &tmp_data
);
9978 int size
= bytes_remaining
;
9983 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9984 prop_atom
, 0, bytes_remaining
,
9986 &actual_type
, &actual_format
,
9987 &actual_size
, &bytes_remaining
,
9988 (unsigned char **) &tmp_data
);
9990 prop_value
= make_string (tmp_data
, size
);
10001 /***********************************************************************
10003 ***********************************************************************/
10005 /* If non-null, an asynchronous timer that, when it expires, displays
10006 a busy cursor on all frames. */
10008 static struct atimer
*busy_cursor_atimer
;
10010 /* Non-zero means a busy cursor is currently shown. */
10012 static int busy_cursor_shown_p
;
10014 /* Number of seconds to wait before displaying a busy cursor. */
10016 static Lisp_Object Vbusy_cursor_delay
;
10018 /* Default number of seconds to wait before displaying a busy
10021 #define DEFAULT_BUSY_CURSOR_DELAY 1
10023 /* Function prototypes. */
10025 static void show_busy_cursor
P_ ((struct atimer
*));
10026 static void hide_busy_cursor
P_ ((void));
10029 /* Cancel a currently active busy-cursor timer, and start a new one. */
10032 start_busy_cursor ()
10035 int secs
, usecs
= 0;
10037 cancel_busy_cursor ();
10039 if (INTEGERP (Vbusy_cursor_delay
)
10040 && XINT (Vbusy_cursor_delay
) > 0)
10041 secs
= XFASTINT (Vbusy_cursor_delay
);
10042 else if (FLOATP (Vbusy_cursor_delay
)
10043 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10046 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10047 secs
= XFASTINT (tem
);
10048 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10051 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10053 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10054 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10055 show_busy_cursor
, NULL
);
10059 /* Cancel the busy cursor timer if active, hide a busy cursor if
10063 cancel_busy_cursor ()
10065 if (busy_cursor_atimer
)
10067 cancel_atimer (busy_cursor_atimer
);
10068 busy_cursor_atimer
= NULL
;
10071 if (busy_cursor_shown_p
)
10072 hide_busy_cursor ();
10076 /* Timer function of busy_cursor_atimer. TIMER is equal to
10077 busy_cursor_atimer.
10079 Display a busy cursor on all frames by mapping the frames'
10080 busy_window. Set the busy_p flag in the frames' output_data.x
10081 structure to indicate that a busy cursor is shown on the
10085 show_busy_cursor (timer
)
10086 struct atimer
*timer
;
10088 /* The timer implementation will cancel this timer automatically
10089 after this function has run. Set busy_cursor_atimer to null
10090 so that we know the timer doesn't have to be canceled. */
10091 busy_cursor_atimer
= NULL
;
10093 if (!busy_cursor_shown_p
)
10095 Lisp_Object rest
, frame
;
10099 FOR_EACH_FRAME (rest
, frame
)
10100 if (FRAME_X_P (XFRAME (frame
)))
10102 struct frame
*f
= XFRAME (frame
);
10104 f
->output_data
.x
->busy_p
= 1;
10106 if (!f
->output_data
.x
->busy_window
)
10108 unsigned long mask
= CWCursor
;
10109 XSetWindowAttributes attrs
;
10111 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10113 f
->output_data
.x
->busy_window
10114 = XCreateWindow (FRAME_X_DISPLAY (f
),
10115 FRAME_OUTER_WINDOW (f
),
10116 0, 0, 32000, 32000, 0, 0,
10122 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10123 XFlush (FRAME_X_DISPLAY (f
));
10126 busy_cursor_shown_p
= 1;
10132 /* Hide the busy cursor on all frames, if it is currently shown. */
10135 hide_busy_cursor ()
10137 if (busy_cursor_shown_p
)
10139 Lisp_Object rest
, frame
;
10142 FOR_EACH_FRAME (rest
, frame
)
10144 struct frame
*f
= XFRAME (frame
);
10147 /* Watch out for newly created frames. */
10148 && f
->output_data
.x
->busy_window
)
10150 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10151 /* Sync here because XTread_socket looks at the busy_p flag
10152 that is reset to zero below. */
10153 XSync (FRAME_X_DISPLAY (f
), False
);
10154 f
->output_data
.x
->busy_p
= 0;
10158 busy_cursor_shown_p
= 0;
10165 /***********************************************************************
10167 ***********************************************************************/
10169 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10172 /* The frame of a currently visible tooltip, or null. */
10174 struct frame
*tip_frame
;
10176 /* If non-nil, a timer started that hides the last tooltip when it
10179 Lisp_Object tip_timer
;
10182 /* Create a frame for a tooltip on the display described by DPYINFO.
10183 PARMS is a list of frame parameters. Value is the frame. */
10186 x_create_tip_frame (dpyinfo
, parms
)
10187 struct x_display_info
*dpyinfo
;
10191 Lisp_Object frame
, tem
;
10193 long window_prompting
= 0;
10195 int count
= specpdl_ptr
- specpdl
;
10196 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10201 /* Use this general default value to start with until we know if
10202 this frame has a specified name. */
10203 Vx_resource_name
= Vinvocation_name
;
10205 #ifdef MULTI_KBOARD
10206 kb
= dpyinfo
->kboard
;
10208 kb
= &the_only_kboard
;
10211 /* Get the name of the frame to use for resource lookup. */
10212 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10213 if (!STRINGP (name
)
10214 && !EQ (name
, Qunbound
)
10216 error ("Invalid frame name--not a string or nil");
10217 Vx_resource_name
= name
;
10220 GCPRO3 (parms
, name
, frame
);
10221 tip_frame
= f
= make_frame (1);
10222 XSETFRAME (frame
, f
);
10223 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10225 f
->output_method
= output_x_window
;
10226 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10227 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10228 f
->output_data
.x
->icon_bitmap
= -1;
10229 f
->output_data
.x
->fontset
= -1;
10230 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10231 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10232 f
->icon_name
= Qnil
;
10233 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10234 #ifdef MULTI_KBOARD
10235 FRAME_KBOARD (f
) = kb
;
10237 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10238 f
->output_data
.x
->explicit_parent
= 0;
10240 /* These colors will be set anyway later, but it's important
10241 to get the color reference counts right, so initialize them! */
10244 struct gcpro gcpro1
;
10246 black
= build_string ("black");
10248 f
->output_data
.x
->foreground_pixel
10249 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10250 f
->output_data
.x
->background_pixel
10251 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10252 f
->output_data
.x
->cursor_pixel
10253 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10254 f
->output_data
.x
->cursor_foreground_pixel
10255 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10256 f
->output_data
.x
->border_pixel
10257 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10258 f
->output_data
.x
->mouse_pixel
10259 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10263 /* Set the name; the functions to which we pass f expect the name to
10265 if (EQ (name
, Qunbound
) || NILP (name
))
10267 f
->name
= build_string (dpyinfo
->x_id_name
);
10268 f
->explicit_name
= 0;
10273 f
->explicit_name
= 1;
10274 /* use the frame's title when getting resources for this frame. */
10275 specbind (Qx_resource_name
, name
);
10278 /* Extract the window parameters from the supplied values
10279 that are needed to determine window geometry. */
10283 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10286 /* First, try whatever font the caller has specified. */
10287 if (STRINGP (font
))
10289 tem
= Fquery_fontset (font
, Qnil
);
10291 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10293 font
= x_new_font (f
, XSTRING (font
)->data
);
10296 /* Try out a font which we hope has bold and italic variations. */
10297 if (!STRINGP (font
))
10298 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10299 if (!STRINGP (font
))
10300 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10301 if (! STRINGP (font
))
10302 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10303 if (! STRINGP (font
))
10304 /* This was formerly the first thing tried, but it finds too many fonts
10305 and takes too long. */
10306 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10307 /* If those didn't work, look for something which will at least work. */
10308 if (! STRINGP (font
))
10309 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10311 if (! STRINGP (font
))
10312 font
= build_string ("fixed");
10314 x_default_parameter (f
, parms
, Qfont
, font
,
10315 "font", "Font", RES_TYPE_STRING
);
10318 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10319 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10321 /* This defaults to 2 in order to match xterm. We recognize either
10322 internalBorderWidth or internalBorder (which is what xterm calls
10324 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10328 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10329 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10330 if (! EQ (value
, Qunbound
))
10331 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10335 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10336 "internalBorderWidth", "internalBorderWidth",
10339 /* Also do the stuff which must be set before the window exists. */
10340 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10341 "foreground", "Foreground", RES_TYPE_STRING
);
10342 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10343 "background", "Background", RES_TYPE_STRING
);
10344 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10345 "pointerColor", "Foreground", RES_TYPE_STRING
);
10346 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10347 "cursorColor", "Foreground", RES_TYPE_STRING
);
10348 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10349 "borderColor", "BorderColor", RES_TYPE_STRING
);
10351 /* Init faces before x_default_parameter is called for scroll-bar
10352 parameters because that function calls x_set_scroll_bar_width,
10353 which calls change_frame_size, which calls Fset_window_buffer,
10354 which runs hooks, which call Fvertical_motion. At the end, we
10355 end up in init_iterator with a null face cache, which should not
10357 init_frame_faces (f
);
10359 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10360 window_prompting
= x_figure_window_size (f
, parms
);
10362 if (window_prompting
& XNegative
)
10364 if (window_prompting
& YNegative
)
10365 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10367 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10371 if (window_prompting
& YNegative
)
10372 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10374 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10377 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10379 XSetWindowAttributes attrs
;
10380 unsigned long mask
;
10383 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10384 /* Window managers look at the override-redirect flag to determine
10385 whether or net to give windows a decoration (Xlib spec, chapter
10387 attrs
.override_redirect
= True
;
10388 attrs
.save_under
= True
;
10389 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10390 /* Arrange for getting MapNotify and UnmapNotify events. */
10391 attrs
.event_mask
= StructureNotifyMask
;
10393 = FRAME_X_WINDOW (f
)
10394 = XCreateWindow (FRAME_X_DISPLAY (f
),
10395 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10396 /* x, y, width, height */
10400 CopyFromParent
, InputOutput
, CopyFromParent
,
10407 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10408 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10409 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10410 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10411 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10412 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10414 /* Dimensions, especially f->height, must be done via change_frame_size.
10415 Change will not be effected unless different from the current
10418 height
= f
->height
;
10420 SET_FRAME_WIDTH (f
, 0);
10421 change_frame_size (f
, height
, width
, 1, 0, 0);
10427 /* It is now ok to make the frame official even if we get an error
10428 below. And the frame needs to be on Vframe_list or making it
10429 visible won't work. */
10430 Vframe_list
= Fcons (frame
, Vframe_list
);
10432 /* Now that the frame is official, it counts as a reference to
10434 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10436 return unbind_to (count
, frame
);
10440 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10441 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10442 A tooltip window is a small X window displaying a string.\n\
10444 FRAME nil or omitted means use the selected frame.\n\
10446 PARMS is an optional list of frame parameters which can be\n\
10447 used to change the tooltip's appearance.\n\
10449 Automatically hide the tooltip after TIMEOUT seconds.\n\
10450 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10452 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10453 the tooltip is displayed at that x-position. Otherwise it is\n\
10454 displayed at the mouse position, with offset DX added (default is 5 if\n\
10455 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10456 parameter is specified, it determines the y-position of the tooltip\n\
10457 window, otherwise it is displayed at the mouse position, with offset\n\
10458 DY added (default is -5).")
10459 (string
, frame
, parms
, timeout
, dx
, dy
)
10460 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10464 Window root
, child
;
10465 Lisp_Object buffer
, top
, left
;
10466 struct buffer
*old_buffer
;
10467 struct text_pos pos
;
10468 int i
, width
, height
;
10469 int root_x
, root_y
, win_x
, win_y
;
10471 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10472 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10473 int count
= specpdl_ptr
- specpdl
;
10475 specbind (Qinhibit_redisplay
, Qt
);
10477 GCPRO4 (string
, parms
, frame
, timeout
);
10479 CHECK_STRING (string
, 0);
10480 f
= check_x_frame (frame
);
10481 if (NILP (timeout
))
10482 timeout
= make_number (5);
10484 CHECK_NATNUM (timeout
, 2);
10487 dx
= make_number (5);
10489 CHECK_NUMBER (dx
, 5);
10492 dy
= make_number (-5);
10494 CHECK_NUMBER (dy
, 6);
10496 /* Hide a previous tip, if any. */
10499 /* Add default values to frame parameters. */
10500 if (NILP (Fassq (Qname
, parms
)))
10501 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10502 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10503 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10504 if (NILP (Fassq (Qborder_width
, parms
)))
10505 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10506 if (NILP (Fassq (Qborder_color
, parms
)))
10507 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10508 if (NILP (Fassq (Qbackground_color
, parms
)))
10509 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10512 /* Create a frame for the tooltip, and record it in the global
10513 variable tip_frame. */
10514 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10515 tip_frame
= f
= XFRAME (frame
);
10517 /* Set up the frame's root window. Currently we use a size of 80
10518 columns x 40 lines. If someone wants to show a larger tip, he
10519 will loose. I don't think this is a realistic case. */
10520 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10521 w
->left
= w
->top
= make_number (0);
10522 w
->width
= make_number (80);
10523 w
->height
= make_number (40);
10525 w
->pseudo_window_p
= 1;
10527 /* Display the tooltip text in a temporary buffer. */
10528 buffer
= Fget_buffer_create (build_string (" *tip*"));
10529 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10530 old_buffer
= current_buffer
;
10531 set_buffer_internal_1 (XBUFFER (buffer
));
10533 Finsert (1, &string
);
10534 clear_glyph_matrix (w
->desired_matrix
);
10535 clear_glyph_matrix (w
->current_matrix
);
10536 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10537 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10539 /* Compute width and height of the tooltip. */
10540 width
= height
= 0;
10541 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10543 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10544 struct glyph
*last
;
10547 /* Stop at the first empty row at the end. */
10548 if (!row
->enabled_p
|| !row
->displays_text_p
)
10551 /* Let the row go over the full width of the frame. */
10552 row
->full_width_p
= 1;
10554 /* There's a glyph at the end of rows that is used to place
10555 the cursor there. Don't include the width of this glyph. */
10556 if (row
->used
[TEXT_AREA
])
10558 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10559 row_width
= row
->pixel_width
- last
->pixel_width
;
10562 row_width
= row
->pixel_width
;
10564 height
+= row
->height
;
10565 width
= max (width
, row_width
);
10568 /* Add the frame's internal border to the width and height the X
10569 window should have. */
10570 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10571 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10573 /* User-specified position? */
10574 left
= Fcdr (Fassq (Qleft
, parms
));
10575 top
= Fcdr (Fassq (Qtop
, parms
));
10577 /* Move the tooltip window where the mouse pointer is. Resize and
10580 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10581 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10584 root_x
+= XINT (dx
);
10585 root_y
+= XINT (dy
);
10587 if (INTEGERP (left
))
10588 root_x
= XINT (left
);
10589 if (INTEGERP (top
))
10590 root_y
= XINT (top
);
10593 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10594 root_x
, root_y
- height
, width
, height
);
10595 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10598 /* Draw into the window. */
10599 w
->must_be_updated_p
= 1;
10600 update_single_window (w
, 1);
10602 /* Restore original current buffer. */
10603 set_buffer_internal_1 (old_buffer
);
10604 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10606 /* Let the tip disappear after timeout seconds. */
10607 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10608 intern ("x-hide-tip"));
10611 return unbind_to (count
, Qnil
);
10615 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10616 "Hide the current tooltip window, if there is any.\n\
10617 Value is t is tooltip was open, nil otherwise.")
10620 int count
= specpdl_ptr
- specpdl
;
10623 specbind (Qinhibit_redisplay
, Qt
);
10625 if (!NILP (tip_timer
))
10627 call1 (intern ("cancel-timer"), tip_timer
);
10635 XSETFRAME (frame
, tip_frame
);
10636 Fdelete_frame (frame
, Qt
);
10641 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10646 /***********************************************************************
10647 File selection dialog
10648 ***********************************************************************/
10652 /* Callback for "OK" and "Cancel" on file selection dialog. */
10655 file_dialog_cb (widget
, client_data
, call_data
)
10657 XtPointer call_data
, client_data
;
10659 int *result
= (int *) client_data
;
10660 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10661 *result
= cb
->reason
;
10665 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10666 "Read file name, prompting with PROMPT in directory DIR.\n\
10667 Use a file selection dialog.\n\
10668 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10669 specified. Don't let the user enter a file name in the file\n\
10670 selection dialog's entry field, if MUSTMATCH is non-nil.")
10671 (prompt
, dir
, default_filename
, mustmatch
)
10672 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10675 struct frame
*f
= SELECTED_FRAME ();
10676 Lisp_Object file
= Qnil
;
10677 Widget dialog
, text
, list
, help
;
10680 extern XtAppContext Xt_app_con
;
10682 XmString dir_xmstring
, pattern_xmstring
;
10683 int popup_activated_flag
;
10684 int count
= specpdl_ptr
- specpdl
;
10685 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10687 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10688 CHECK_STRING (prompt
, 0);
10689 CHECK_STRING (dir
, 1);
10691 /* Prevent redisplay. */
10692 specbind (Qinhibit_redisplay
, Qt
);
10696 /* Create the dialog with PROMPT as title, using DIR as initial
10697 directory and using "*" as pattern. */
10698 dir
= Fexpand_file_name (dir
, Qnil
);
10699 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10700 pattern_xmstring
= XmStringCreateLocalized ("*");
10702 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10703 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10704 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10705 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10706 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10707 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10709 XmStringFree (dir_xmstring
);
10710 XmStringFree (pattern_xmstring
);
10712 /* Add callbacks for OK and Cancel. */
10713 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10714 (XtPointer
) &result
);
10715 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10716 (XtPointer
) &result
);
10718 /* Disable the help button since we can't display help. */
10719 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10720 XtSetSensitive (help
, False
);
10722 /* Mark OK button as default. */
10723 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10724 XmNshowAsDefault
, True
, NULL
);
10726 /* If MUSTMATCH is non-nil, disable the file entry field of the
10727 dialog, so that the user must select a file from the files list
10728 box. We can't remove it because we wouldn't have a way to get at
10729 the result file name, then. */
10730 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10731 if (!NILP (mustmatch
))
10734 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10735 XtSetSensitive (text
, False
);
10736 XtSetSensitive (label
, False
);
10739 /* Manage the dialog, so that list boxes get filled. */
10740 XtManageChild (dialog
);
10742 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10743 must include the path for this to work. */
10744 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10745 if (STRINGP (default_filename
))
10747 XmString default_xmstring
;
10751 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10753 if (!XmListItemExists (list
, default_xmstring
))
10755 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10756 XmListAddItem (list
, default_xmstring
, 0);
10760 item_pos
= XmListItemPos (list
, default_xmstring
);
10761 XmStringFree (default_xmstring
);
10763 /* Select the item and scroll it into view. */
10764 XmListSelectPos (list
, item_pos
, True
);
10765 XmListSetPos (list
, item_pos
);
10768 #ifdef HAVE_MOTIF_2_1
10770 /* Process events until the user presses Cancel or OK. */
10772 while (result
== 0 || XtAppPending (Xt_app_con
))
10773 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10775 #else /* not HAVE_MOTIF_2_1 */
10777 /* Process all events until the user presses Cancel or OK. */
10778 for (result
= 0; result
== 0;)
10781 Widget widget
, parent
;
10783 XtAppNextEvent (Xt_app_con
, &event
);
10785 /* See if the receiver of the event is one of the widgets of
10786 the file selection dialog. If so, dispatch it. If not,
10788 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10790 while (parent
&& parent
!= dialog
)
10791 parent
= XtParent (parent
);
10793 if (parent
== dialog
10794 || (event
.type
== Expose
10795 && !process_expose_from_menu (event
)))
10796 XtDispatchEvent (&event
);
10799 #endif /* not HAVE_MOTIF_2_1 */
10801 /* Get the result. */
10802 if (result
== XmCR_OK
)
10807 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
10808 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10809 XmStringFree (text
);
10810 file
= build_string (data
);
10817 XtUnmanageChild (dialog
);
10818 XtDestroyWidget (dialog
);
10822 /* Make "Cancel" equivalent to C-g. */
10824 Fsignal (Qquit
, Qnil
);
10826 return unbind_to (count
, file
);
10829 #endif /* USE_MOTIF */
10833 /***********************************************************************
10835 ***********************************************************************/
10840 /* This is zero if not using X windows. */
10843 /* The section below is built by the lisp expression at the top of the file,
10844 just above where these variables are declared. */
10845 /*&&& init symbols here &&&*/
10846 Qauto_raise
= intern ("auto-raise");
10847 staticpro (&Qauto_raise
);
10848 Qauto_lower
= intern ("auto-lower");
10849 staticpro (&Qauto_lower
);
10850 Qbar
= intern ("bar");
10852 Qborder_color
= intern ("border-color");
10853 staticpro (&Qborder_color
);
10854 Qborder_width
= intern ("border-width");
10855 staticpro (&Qborder_width
);
10856 Qbox
= intern ("box");
10858 Qcursor_color
= intern ("cursor-color");
10859 staticpro (&Qcursor_color
);
10860 Qcursor_type
= intern ("cursor-type");
10861 staticpro (&Qcursor_type
);
10862 Qgeometry
= intern ("geometry");
10863 staticpro (&Qgeometry
);
10864 Qicon_left
= intern ("icon-left");
10865 staticpro (&Qicon_left
);
10866 Qicon_top
= intern ("icon-top");
10867 staticpro (&Qicon_top
);
10868 Qicon_type
= intern ("icon-type");
10869 staticpro (&Qicon_type
);
10870 Qicon_name
= intern ("icon-name");
10871 staticpro (&Qicon_name
);
10872 Qinternal_border_width
= intern ("internal-border-width");
10873 staticpro (&Qinternal_border_width
);
10874 Qleft
= intern ("left");
10875 staticpro (&Qleft
);
10876 Qright
= intern ("right");
10877 staticpro (&Qright
);
10878 Qmouse_color
= intern ("mouse-color");
10879 staticpro (&Qmouse_color
);
10880 Qnone
= intern ("none");
10881 staticpro (&Qnone
);
10882 Qparent_id
= intern ("parent-id");
10883 staticpro (&Qparent_id
);
10884 Qscroll_bar_width
= intern ("scroll-bar-width");
10885 staticpro (&Qscroll_bar_width
);
10886 Qsuppress_icon
= intern ("suppress-icon");
10887 staticpro (&Qsuppress_icon
);
10888 Qundefined_color
= intern ("undefined-color");
10889 staticpro (&Qundefined_color
);
10890 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10891 staticpro (&Qvertical_scroll_bars
);
10892 Qvisibility
= intern ("visibility");
10893 staticpro (&Qvisibility
);
10894 Qwindow_id
= intern ("window-id");
10895 staticpro (&Qwindow_id
);
10896 Qouter_window_id
= intern ("outer-window-id");
10897 staticpro (&Qouter_window_id
);
10898 Qx_frame_parameter
= intern ("x-frame-parameter");
10899 staticpro (&Qx_frame_parameter
);
10900 Qx_resource_name
= intern ("x-resource-name");
10901 staticpro (&Qx_resource_name
);
10902 Quser_position
= intern ("user-position");
10903 staticpro (&Quser_position
);
10904 Quser_size
= intern ("user-size");
10905 staticpro (&Quser_size
);
10906 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10907 staticpro (&Qscroll_bar_foreground
);
10908 Qscroll_bar_background
= intern ("scroll-bar-background");
10909 staticpro (&Qscroll_bar_background
);
10910 Qscreen_gamma
= intern ("screen-gamma");
10911 staticpro (&Qscreen_gamma
);
10912 Qline_spacing
= intern ("line-spacing");
10913 staticpro (&Qline_spacing
);
10914 Qcenter
= intern ("center");
10915 staticpro (&Qcenter
);
10916 Qcompound_text
= intern ("compound-text");
10917 staticpro (&Qcompound_text
);
10918 /* This is the end of symbol initialization. */
10920 /* Text property `display' should be nonsticky by default. */
10921 Vtext_property_default_nonsticky
10922 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10925 Qlaplace
= intern ("laplace");
10926 staticpro (&Qlaplace
);
10927 Qemboss
= intern ("emboss");
10928 staticpro (&Qemboss
);
10929 Qedge_detection
= intern ("edge-detection");
10930 staticpro (&Qedge_detection
);
10931 Qheuristic
= intern ("heuristic");
10932 staticpro (&Qheuristic
);
10933 QCmatrix
= intern (":matrix");
10934 staticpro (&QCmatrix
);
10935 QCcolor_adjustment
= intern (":color-adjustment");
10936 staticpro (&QCcolor_adjustment
);
10937 QCmask
= intern (":mask");
10938 staticpro (&QCmask
);
10940 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10941 staticpro (&Qface_set_after_frame_default
);
10943 Fput (Qundefined_color
, Qerror_conditions
,
10944 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10945 Fput (Qundefined_color
, Qerror_message
,
10946 build_string ("Undefined color"));
10948 init_x_parm_symbols ();
10950 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
10951 "Non-nil means always draw a cross over disabled images.\n\
10952 Disabled images are those having an `:algorithm disabled' property.\n\
10953 A cross is always drawn on black & white displays.");
10954 cross_disabled_images
= 0;
10956 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10957 "List of directories to search for bitmap files for X.");
10958 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10960 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10961 "The shape of the pointer when over text.\n\
10962 Changing the value does not affect existing frames\n\
10963 unless you set the mouse color.");
10964 Vx_pointer_shape
= Qnil
;
10966 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10967 "The name Emacs uses to look up X resources.\n\
10968 `x-get-resource' uses this as the first component of the instance name\n\
10969 when requesting resource values.\n\
10970 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10971 was invoked, or to the value specified with the `-name' or `-rn'\n\
10972 switches, if present.\n\
10974 It may be useful to bind this variable locally around a call\n\
10975 to `x-get-resource'. See also the variable `x-resource-class'.");
10976 Vx_resource_name
= Qnil
;
10978 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10979 "The class Emacs uses to look up X resources.\n\
10980 `x-get-resource' uses this as the first component of the instance class\n\
10981 when requesting resource values.\n\
10982 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10984 Setting this variable permanently is not a reasonable thing to do,\n\
10985 but binding this variable locally around a call to `x-get-resource'\n\
10986 is a reasonable practice. See also the variable `x-resource-name'.");
10987 Vx_resource_class
= build_string (EMACS_CLASS
);
10989 #if 0 /* This doesn't really do anything. */
10990 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10991 "The shape of the pointer when not over text.\n\
10992 This variable takes effect when you create a new frame\n\
10993 or when you set the mouse color.");
10995 Vx_nontext_pointer_shape
= Qnil
;
10997 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10998 "The shape of the pointer when Emacs is busy.\n\
10999 This variable takes effect when you create a new frame\n\
11000 or when you set the mouse color.");
11001 Vx_busy_pointer_shape
= Qnil
;
11003 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11004 "Non-zero means Emacs displays a busy cursor on window systems.");
11005 display_busy_cursor_p
= 1;
11007 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11008 "*Seconds to wait before displaying a busy-cursor.\n\
11009 Value must be an integer or float.");
11010 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11012 #if 0 /* This doesn't really do anything. */
11013 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11014 "The shape of the pointer when over the mode line.\n\
11015 This variable takes effect when you create a new frame\n\
11016 or when you set the mouse color.");
11018 Vx_mode_pointer_shape
= Qnil
;
11020 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11021 &Vx_sensitive_text_pointer_shape
,
11022 "The shape of the pointer when over mouse-sensitive text.\n\
11023 This variable takes effect when you create a new frame\n\
11024 or when you set the mouse color.");
11025 Vx_sensitive_text_pointer_shape
= Qnil
;
11027 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11028 "A string indicating the foreground color of the cursor box.");
11029 Vx_cursor_fore_pixel
= Qnil
;
11031 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11032 "Non-nil if no X window manager is in use.\n\
11033 Emacs doesn't try to figure this out; this is always nil\n\
11034 unless you set it to something else.");
11035 /* We don't have any way to find this out, so set it to nil
11036 and maybe the user would like to set it to t. */
11037 Vx_no_window_manager
= Qnil
;
11039 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11040 &Vx_pixel_size_width_font_regexp
,
11041 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11043 Since Emacs gets width of a font matching with this regexp from\n\
11044 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11045 such a font. This is especially effective for such large fonts as\n\
11046 Chinese, Japanese, and Korean.");
11047 Vx_pixel_size_width_font_regexp
= Qnil
;
11049 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11050 "Time after which cached images are removed from the cache.\n\
11051 When an image has not been displayed this many seconds, remove it\n\
11052 from the image cache. Value must be an integer or nil with nil\n\
11053 meaning don't clear the cache.");
11054 Vimage_cache_eviction_delay
= make_number (30 * 60);
11056 #ifdef USE_X_TOOLKIT
11057 Fprovide (intern ("x-toolkit"));
11060 Fprovide (intern ("motif"));
11063 defsubr (&Sx_get_resource
);
11065 /* X window properties. */
11066 defsubr (&Sx_change_window_property
);
11067 defsubr (&Sx_delete_window_property
);
11068 defsubr (&Sx_window_property
);
11070 defsubr (&Sxw_display_color_p
);
11071 defsubr (&Sx_display_grayscale_p
);
11072 defsubr (&Sxw_color_defined_p
);
11073 defsubr (&Sxw_color_values
);
11074 defsubr (&Sx_server_max_request_size
);
11075 defsubr (&Sx_server_vendor
);
11076 defsubr (&Sx_server_version
);
11077 defsubr (&Sx_display_pixel_width
);
11078 defsubr (&Sx_display_pixel_height
);
11079 defsubr (&Sx_display_mm_width
);
11080 defsubr (&Sx_display_mm_height
);
11081 defsubr (&Sx_display_screens
);
11082 defsubr (&Sx_display_planes
);
11083 defsubr (&Sx_display_color_cells
);
11084 defsubr (&Sx_display_visual_class
);
11085 defsubr (&Sx_display_backing_store
);
11086 defsubr (&Sx_display_save_under
);
11087 defsubr (&Sx_parse_geometry
);
11088 defsubr (&Sx_create_frame
);
11089 defsubr (&Sx_open_connection
);
11090 defsubr (&Sx_close_connection
);
11091 defsubr (&Sx_display_list
);
11092 defsubr (&Sx_synchronize
);
11093 defsubr (&Sx_focus_frame
);
11095 /* Setting callback functions for fontset handler. */
11096 get_font_info_func
= x_get_font_info
;
11098 #if 0 /* This function pointer doesn't seem to be used anywhere.
11099 And the pointer assigned has the wrong type, anyway. */
11100 list_fonts_func
= x_list_fonts
;
11103 load_font_func
= x_load_font
;
11104 find_ccl_program_func
= x_find_ccl_program
;
11105 query_font_func
= x_query_font
;
11106 set_frame_fontset_func
= x_set_font
;
11107 check_window_system_func
= check_x
;
11110 Qxbm
= intern ("xbm");
11112 QCtype
= intern (":type");
11113 staticpro (&QCtype
);
11114 QCalgorithm
= intern (":algorithm");
11115 staticpro (&QCalgorithm
);
11116 QCheuristic_mask
= intern (":heuristic-mask");
11117 staticpro (&QCheuristic_mask
);
11118 QCcolor_symbols
= intern (":color-symbols");
11119 staticpro (&QCcolor_symbols
);
11120 QCascent
= intern (":ascent");
11121 staticpro (&QCascent
);
11122 QCmargin
= intern (":margin");
11123 staticpro (&QCmargin
);
11124 QCrelief
= intern (":relief");
11125 staticpro (&QCrelief
);
11126 Qpostscript
= intern ("postscript");
11127 staticpro (&Qpostscript
);
11128 QCloader
= intern (":loader");
11129 staticpro (&QCloader
);
11130 QCbounding_box
= intern (":bounding-box");
11131 staticpro (&QCbounding_box
);
11132 QCpt_width
= intern (":pt-width");
11133 staticpro (&QCpt_width
);
11134 QCpt_height
= intern (":pt-height");
11135 staticpro (&QCpt_height
);
11136 QCindex
= intern (":index");
11137 staticpro (&QCindex
);
11138 Qpbm
= intern ("pbm");
11142 Qxpm
= intern ("xpm");
11147 Qjpeg
= intern ("jpeg");
11148 staticpro (&Qjpeg
);
11152 Qtiff
= intern ("tiff");
11153 staticpro (&Qtiff
);
11157 Qgif
= intern ("gif");
11162 Qpng
= intern ("png");
11166 defsubr (&Sclear_image_cache
);
11167 defsubr (&Simage_size
);
11168 defsubr (&Simage_mask_p
);
11170 busy_cursor_atimer
= NULL
;
11171 busy_cursor_shown_p
= 0;
11173 defsubr (&Sx_show_tip
);
11174 defsubr (&Sx_hide_tip
);
11175 staticpro (&tip_timer
);
11179 defsubr (&Sx_file_dialog
);
11187 image_types
= NULL
;
11188 Vimage_types
= Qnil
;
11190 define_image_type (&xbm_type
);
11191 define_image_type (&gs_type
);
11192 define_image_type (&pbm_type
);
11195 define_image_type (&xpm_type
);
11199 define_image_type (&jpeg_type
);
11203 define_image_type (&tiff_type
);
11207 define_image_type (&gif_type
);
11211 define_image_type (&png_type
);
11215 #endif /* HAVE_X_WINDOWS */