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_change_window_heights
P_ ((Lisp_Object
, int));
748 static void x_disable_image
P_ ((struct frame
*, struct image
*));
749 static void x_create_im
P_ ((struct frame
*));
750 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
763 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
768 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
774 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
776 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
778 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
783 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
784 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
786 static void init_color_table
P_ ((void));
787 static void free_color_table
P_ ((void));
788 static unsigned long *colors_in_color_table
P_ ((int *n
));
789 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
790 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
794 static struct x_frame_parm_table x_frame_parms
[] =
796 "auto-raise", x_set_autoraise
,
797 "auto-lower", x_set_autolower
,
798 "background-color", x_set_background_color
,
799 "border-color", x_set_border_color
,
800 "border-width", x_set_border_width
,
801 "cursor-color", x_set_cursor_color
,
802 "cursor-type", x_set_cursor_type
,
804 "foreground-color", x_set_foreground_color
,
805 "icon-name", x_set_icon_name
,
806 "icon-type", x_set_icon_type
,
807 "internal-border-width", x_set_internal_border_width
,
808 "menu-bar-lines", x_set_menu_bar_lines
,
809 "mouse-color", x_set_mouse_color
,
810 "name", x_explicitly_set_name
,
811 "scroll-bar-width", x_set_scroll_bar_width
,
812 "title", x_set_title
,
813 "unsplittable", x_set_unsplittable
,
814 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
815 "visibility", x_set_visibility
,
816 "tool-bar-lines", x_set_tool_bar_lines
,
817 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
818 "scroll-bar-background", x_set_scroll_bar_background
,
819 "screen-gamma", x_set_screen_gamma
,
820 "line-spacing", x_set_line_spacing
823 /* Attach the `x-frame-parameter' properties to
824 the Lisp symbol names of parameters relevant to X. */
827 init_x_parm_symbols ()
831 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
832 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
836 /* Change the parameters of frame F as specified by ALIST.
837 If a parameter is not specially recognized, do nothing special;
838 otherwise call the `x_set_...' function for that parameter.
839 Except for certain geometry properties, always call store_frame_param
840 to store the new value in the parameter alist. */
843 x_set_frame_parameters (f
, alist
)
849 /* If both of these parameters are present, it's more efficient to
850 set them both at once. So we wait until we've looked at the
851 entire list before we set them. */
855 Lisp_Object left
, top
;
857 /* Same with these. */
858 Lisp_Object icon_left
, icon_top
;
860 /* Record in these vectors all the parms specified. */
864 int left_no_change
= 0, top_no_change
= 0;
865 int icon_left_no_change
= 0, icon_top_no_change
= 0;
867 struct gcpro gcpro1
, gcpro2
;
870 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
873 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
874 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
876 /* Extract parm names and values into those vectors. */
879 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
884 parms
[i
] = Fcar (elt
);
885 values
[i
] = Fcdr (elt
);
888 /* TAIL and ALIST are not used again below here. */
891 GCPRO2 (*parms
, *values
);
895 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
896 because their values appear in VALUES and strings are not valid. */
897 top
= left
= Qunbound
;
898 icon_left
= icon_top
= Qunbound
;
900 /* Provide default values for HEIGHT and WIDTH. */
901 if (FRAME_NEW_WIDTH (f
))
902 width
= FRAME_NEW_WIDTH (f
);
904 width
= FRAME_WIDTH (f
);
906 if (FRAME_NEW_HEIGHT (f
))
907 height
= FRAME_NEW_HEIGHT (f
);
909 height
= FRAME_HEIGHT (f
);
911 /* Process foreground_color and background_color before anything else.
912 They are independent of other properties, but other properties (e.g.,
913 cursor_color) are dependent upon them. */
914 for (p
= 0; p
< i
; p
++)
916 Lisp_Object prop
, val
;
920 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
922 register Lisp_Object param_index
, old_value
;
924 param_index
= Fget (prop
, Qx_frame_parameter
);
925 old_value
= get_frame_param (f
, prop
);
926 store_frame_param (f
, prop
, val
);
927 if (NATNUMP (param_index
)
928 && (XFASTINT (param_index
)
929 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
930 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
934 /* Now process them in reverse of specified order. */
935 for (i
--; i
>= 0; i
--)
937 Lisp_Object prop
, val
;
942 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
943 width
= XFASTINT (val
);
944 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
945 height
= XFASTINT (val
);
946 else if (EQ (prop
, Qtop
))
948 else if (EQ (prop
, Qleft
))
950 else if (EQ (prop
, Qicon_top
))
952 else if (EQ (prop
, Qicon_left
))
954 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
955 /* Processed above. */
959 register Lisp_Object param_index
, old_value
;
961 param_index
= Fget (prop
, Qx_frame_parameter
);
962 old_value
= get_frame_param (f
, prop
);
963 store_frame_param (f
, prop
, val
);
964 if (NATNUMP (param_index
)
965 && (XFASTINT (param_index
)
966 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
967 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
971 /* Don't die if just one of these was set. */
972 if (EQ (left
, Qunbound
))
975 if (f
->output_data
.x
->left_pos
< 0)
976 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
978 XSETINT (left
, f
->output_data
.x
->left_pos
);
980 if (EQ (top
, Qunbound
))
983 if (f
->output_data
.x
->top_pos
< 0)
984 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
986 XSETINT (top
, f
->output_data
.x
->top_pos
);
989 /* If one of the icon positions was not set, preserve or default it. */
990 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
992 icon_left_no_change
= 1;
993 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
994 if (NILP (icon_left
))
995 XSETINT (icon_left
, 0);
997 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
999 icon_top_no_change
= 1;
1000 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1001 if (NILP (icon_top
))
1002 XSETINT (icon_top
, 0);
1005 /* Don't set these parameters unless they've been explicitly
1006 specified. The window might be mapped or resized while we're in
1007 this function, and we don't want to override that unless the lisp
1008 code has asked for it.
1010 Don't set these parameters unless they actually differ from the
1011 window's current parameters; the window may not actually exist
1016 check_frame_size (f
, &height
, &width
);
1018 XSETFRAME (frame
, f
);
1020 if (width
!= FRAME_WIDTH (f
)
1021 || height
!= FRAME_HEIGHT (f
)
1022 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1023 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1025 if ((!NILP (left
) || !NILP (top
))
1026 && ! (left_no_change
&& top_no_change
)
1027 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1028 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1033 /* Record the signs. */
1034 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1035 if (EQ (left
, Qminus
))
1036 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1037 else if (INTEGERP (left
))
1039 leftpos
= XINT (left
);
1041 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1043 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1044 && CONSP (XCDR (left
))
1045 && INTEGERP (XCAR (XCDR (left
))))
1047 leftpos
= - XINT (XCAR (XCDR (left
)));
1048 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1050 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1051 && CONSP (XCDR (left
))
1052 && INTEGERP (XCAR (XCDR (left
))))
1054 leftpos
= XINT (XCAR (XCDR (left
)));
1057 if (EQ (top
, Qminus
))
1058 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1059 else if (INTEGERP (top
))
1061 toppos
= XINT (top
);
1063 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1065 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1066 && CONSP (XCDR (top
))
1067 && INTEGERP (XCAR (XCDR (top
))))
1069 toppos
= - XINT (XCAR (XCDR (top
)));
1070 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1072 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1073 && CONSP (XCDR (top
))
1074 && INTEGERP (XCAR (XCDR (top
))))
1076 toppos
= XINT (XCAR (XCDR (top
)));
1080 /* Store the numeric value of the position. */
1081 f
->output_data
.x
->top_pos
= toppos
;
1082 f
->output_data
.x
->left_pos
= leftpos
;
1084 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1086 /* Actually set that position, and convert to absolute. */
1087 x_set_offset (f
, leftpos
, toppos
, -1);
1090 if ((!NILP (icon_left
) || !NILP (icon_top
))
1091 && ! (icon_left_no_change
&& icon_top_no_change
))
1092 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1098 /* Store the screen positions of frame F into XPTR and YPTR.
1099 These are the positions of the containing window manager window,
1100 not Emacs's own window. */
1103 x_real_positions (f
, xptr
, yptr
)
1110 /* This is pretty gross, but seems to be the easiest way out of
1111 the problem that arises when restarting window-managers. */
1113 #ifdef USE_X_TOOLKIT
1114 Window outer
= (f
->output_data
.x
->widget
1115 ? XtWindow (f
->output_data
.x
->widget
)
1116 : FRAME_X_WINDOW (f
));
1118 Window outer
= f
->output_data
.x
->window_desc
;
1120 Window tmp_root_window
;
1121 Window
*tmp_children
;
1122 unsigned int tmp_nchildren
;
1126 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1127 Window outer_window
;
1129 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1130 &f
->output_data
.x
->parent_desc
,
1131 &tmp_children
, &tmp_nchildren
);
1132 XFree ((char *) tmp_children
);
1136 /* Find the position of the outside upper-left corner of
1137 the inner window, with respect to the outer window. */
1138 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1139 outer_window
= f
->output_data
.x
->parent_desc
;
1141 outer_window
= outer
;
1143 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1145 /* From-window, to-window. */
1147 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1149 /* From-position, to-position. */
1150 0, 0, &win_x
, &win_y
,
1155 /* It is possible for the window returned by the XQueryNotify
1156 to become invalid by the time we call XTranslateCoordinates.
1157 That can happen when you restart some window managers.
1158 If so, we get an error in XTranslateCoordinates.
1159 Detect that and try the whole thing over. */
1160 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1162 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1166 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1173 /* Insert a description of internally-recorded parameters of frame X
1174 into the parameter alist *ALISTPTR that is to be given to the user.
1175 Only parameters that are specific to the X window system
1176 and whose values are not correctly recorded in the frame's
1177 param_alist need to be considered here. */
1180 x_report_frame_params (f
, alistptr
)
1182 Lisp_Object
*alistptr
;
1187 /* Represent negative positions (off the top or left screen edge)
1188 in a way that Fmodify_frame_parameters will understand correctly. */
1189 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1190 if (f
->output_data
.x
->left_pos
>= 0)
1191 store_in_alist (alistptr
, Qleft
, tem
);
1193 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1195 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1196 if (f
->output_data
.x
->top_pos
>= 0)
1197 store_in_alist (alistptr
, Qtop
, tem
);
1199 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1201 store_in_alist (alistptr
, Qborder_width
,
1202 make_number (f
->output_data
.x
->border_width
));
1203 store_in_alist (alistptr
, Qinternal_border_width
,
1204 make_number (f
->output_data
.x
->internal_border_width
));
1205 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1206 store_in_alist (alistptr
, Qwindow_id
,
1207 build_string (buf
));
1208 #ifdef USE_X_TOOLKIT
1209 /* Tooltip frame may not have this widget. */
1210 if (f
->output_data
.x
->widget
)
1212 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1213 store_in_alist (alistptr
, Qouter_window_id
,
1214 build_string (buf
));
1215 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1216 FRAME_SAMPLE_VISIBILITY (f
);
1217 store_in_alist (alistptr
, Qvisibility
,
1218 (FRAME_VISIBLE_P (f
) ? Qt
1219 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1220 store_in_alist (alistptr
, Qdisplay
,
1221 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1223 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1226 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1227 store_in_alist (alistptr
, Qparent_id
, tem
);
1232 /* Gamma-correct COLOR on frame F. */
1235 gamma_correct (f
, color
)
1241 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1242 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1243 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1248 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1249 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1250 allocate the color. Value is zero if COLOR_NAME is invalid, or
1251 no color could be allocated. */
1254 x_defined_color (f
, color_name
, color
, alloc_p
)
1261 Display
*dpy
= FRAME_X_DISPLAY (f
);
1262 Colormap cmap
= FRAME_X_COLORMAP (f
);
1265 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1266 if (success_p
&& alloc_p
)
1267 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1274 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1275 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1276 Signal an error if color can't be allocated. */
1279 x_decode_color (f
, color_name
, mono_color
)
1281 Lisp_Object color_name
;
1286 CHECK_STRING (color_name
, 0);
1288 #if 0 /* Don't do this. It's wrong when we're not using the default
1289 colormap, it makes freeing difficult, and it's probably not
1290 an important optimization. */
1291 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1292 return BLACK_PIX_DEFAULT (f
);
1293 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1294 return WHITE_PIX_DEFAULT (f
);
1297 /* Return MONO_COLOR for monochrome frames. */
1298 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1301 /* x_defined_color is responsible for coping with failures
1302 by looking for a near-miss. */
1303 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1306 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1307 Fcons (color_name
, Qnil
)));
1313 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1314 the previous value of that parameter, NEW_VALUE is the new value. */
1317 x_set_line_spacing (f
, new_value
, old_value
)
1319 Lisp_Object new_value
, old_value
;
1321 if (NILP (new_value
))
1322 f
->extra_line_spacing
= 0;
1323 else if (NATNUMP (new_value
))
1324 f
->extra_line_spacing
= XFASTINT (new_value
);
1326 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1327 Fcons (new_value
, Qnil
)));
1328 if (FRAME_VISIBLE_P (f
))
1333 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1334 the previous value of that parameter, NEW_VALUE is the new value. */
1337 x_set_screen_gamma (f
, new_value
, old_value
)
1339 Lisp_Object new_value
, old_value
;
1341 if (NILP (new_value
))
1343 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1344 /* The value 0.4545 is the normal viewing gamma. */
1345 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1347 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1348 Fcons (new_value
, Qnil
)));
1350 clear_face_cache (0);
1354 /* Functions called only from `x_set_frame_param'
1355 to set individual parameters.
1357 If FRAME_X_WINDOW (f) is 0,
1358 the frame is being created and its X-window does not exist yet.
1359 In that case, just record the parameter's new value
1360 in the standard place; do not attempt to change the window. */
1363 x_set_foreground_color (f
, arg
, oldval
)
1365 Lisp_Object arg
, oldval
;
1368 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1370 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1371 f
->output_data
.x
->foreground_pixel
= pixel
;
1373 if (FRAME_X_WINDOW (f
) != 0)
1376 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1377 f
->output_data
.x
->foreground_pixel
);
1378 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1379 f
->output_data
.x
->foreground_pixel
);
1381 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1382 if (FRAME_VISIBLE_P (f
))
1388 x_set_background_color (f
, arg
, oldval
)
1390 Lisp_Object arg
, oldval
;
1393 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1395 unload_color (f
, f
->output_data
.x
->background_pixel
);
1396 f
->output_data
.x
->background_pixel
= pixel
;
1398 if (FRAME_X_WINDOW (f
) != 0)
1401 /* The main frame area. */
1402 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1403 f
->output_data
.x
->background_pixel
);
1404 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1405 f
->output_data
.x
->background_pixel
);
1406 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1407 f
->output_data
.x
->background_pixel
);
1408 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1409 f
->output_data
.x
->background_pixel
);
1412 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1413 bar
= XSCROLL_BAR (bar
)->next
)
1414 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1415 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1416 f
->output_data
.x
->background_pixel
);
1420 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1422 if (FRAME_VISIBLE_P (f
))
1428 x_set_mouse_color (f
, arg
, oldval
)
1430 Lisp_Object arg
, oldval
;
1432 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1435 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1436 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1438 /* Don't let pointers be invisible. */
1439 if (mask_color
== pixel
1440 && mask_color
== f
->output_data
.x
->background_pixel
)
1441 pixel
= f
->output_data
.x
->foreground_pixel
;
1443 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1444 f
->output_data
.x
->mouse_pixel
= pixel
;
1448 /* It's not okay to crash if the user selects a screwy cursor. */
1449 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1451 if (!EQ (Qnil
, Vx_pointer_shape
))
1453 CHECK_NUMBER (Vx_pointer_shape
, 0);
1454 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1457 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1458 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1460 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1462 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1463 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1464 XINT (Vx_nontext_pointer_shape
));
1467 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1468 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1470 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1472 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1473 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1474 XINT (Vx_busy_pointer_shape
));
1477 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1478 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1480 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1481 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1483 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1484 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1485 XINT (Vx_mode_pointer_shape
));
1488 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1489 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1491 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1493 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1495 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1496 XINT (Vx_sensitive_text_pointer_shape
));
1499 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1501 /* Check and report errors with the above calls. */
1502 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1503 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1506 XColor fore_color
, back_color
;
1508 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1509 back_color
.pixel
= mask_color
;
1510 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1512 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1514 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1515 &fore_color
, &back_color
);
1516 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1517 &fore_color
, &back_color
);
1518 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1519 &fore_color
, &back_color
);
1520 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1521 &fore_color
, &back_color
);
1522 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1523 &fore_color
, &back_color
);
1526 if (FRAME_X_WINDOW (f
) != 0)
1527 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1529 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1530 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1531 f
->output_data
.x
->text_cursor
= cursor
;
1533 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1534 && f
->output_data
.x
->nontext_cursor
!= 0)
1535 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1536 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1538 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1539 && f
->output_data
.x
->busy_cursor
!= 0)
1540 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1541 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1543 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1544 && f
->output_data
.x
->modeline_cursor
!= 0)
1545 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1546 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1548 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1549 && f
->output_data
.x
->cross_cursor
!= 0)
1550 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1551 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1553 XFlush (FRAME_X_DISPLAY (f
));
1556 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1560 x_set_cursor_color (f
, arg
, oldval
)
1562 Lisp_Object arg
, oldval
;
1564 unsigned long fore_pixel
, pixel
;
1565 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1567 if (!NILP (Vx_cursor_fore_pixel
))
1569 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1570 WHITE_PIX_DEFAULT (f
));
1571 fore_pixel_allocated_p
= 1;
1574 fore_pixel
= f
->output_data
.x
->background_pixel
;
1576 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1577 pixel_allocated_p
= 1;
1579 /* Make sure that the cursor color differs from the background color. */
1580 if (pixel
== f
->output_data
.x
->background_pixel
)
1582 if (pixel_allocated_p
)
1584 x_free_colors (f
, &pixel
, 1);
1585 pixel_allocated_p
= 0;
1588 pixel
= f
->output_data
.x
->mouse_pixel
;
1589 if (pixel
== fore_pixel
)
1591 if (fore_pixel_allocated_p
)
1593 x_free_colors (f
, &fore_pixel
, 1);
1594 fore_pixel_allocated_p
= 0;
1596 fore_pixel
= f
->output_data
.x
->background_pixel
;
1600 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1601 if (!fore_pixel_allocated_p
)
1602 fore_pixel
= x_copy_color (f
, fore_pixel
);
1603 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1605 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1606 if (!pixel_allocated_p
)
1607 pixel
= x_copy_color (f
, pixel
);
1608 f
->output_data
.x
->cursor_pixel
= pixel
;
1610 if (FRAME_X_WINDOW (f
) != 0)
1613 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1614 f
->output_data
.x
->cursor_pixel
);
1615 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1619 if (FRAME_VISIBLE_P (f
))
1621 x_update_cursor (f
, 0);
1622 x_update_cursor (f
, 1);
1626 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1629 /* Set the border-color of frame F to value described by ARG.
1630 ARG can be a string naming a color.
1631 The border-color is used for the border that is drawn by the X server.
1632 Note that this does not fully take effect if done before
1633 F has an x-window; it must be redone when the window is created.
1635 Note: this is done in two routines because of the way X10 works.
1637 Note: under X11, this is normally the province of the window manager,
1638 and so emacs' border colors may be overridden. */
1641 x_set_border_color (f
, arg
, oldval
)
1643 Lisp_Object arg
, oldval
;
1647 CHECK_STRING (arg
, 0);
1648 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1649 x_set_border_pixel (f
, pix
);
1650 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1653 /* Set the border-color of frame F to pixel value PIX.
1654 Note that this does not fully take effect if done before
1655 F has an x-window. */
1658 x_set_border_pixel (f
, pix
)
1662 unload_color (f
, f
->output_data
.x
->border_pixel
);
1663 f
->output_data
.x
->border_pixel
= pix
;
1665 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1668 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1669 (unsigned long)pix
);
1672 if (FRAME_VISIBLE_P (f
))
1678 /* Value is the internal representation of the specified cursor type
1679 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1680 of the bar cursor. */
1682 enum text_cursor_kinds
1683 x_specified_cursor_type (arg
, width
)
1687 enum text_cursor_kinds type
;
1694 else if (CONSP (arg
)
1695 && EQ (XCAR (arg
), Qbar
)
1696 && INTEGERP (XCDR (arg
))
1697 && XINT (XCDR (arg
)) >= 0)
1700 *width
= XINT (XCDR (arg
));
1702 else if (NILP (arg
))
1705 /* Treat anything unknown as "box cursor".
1706 It was bad to signal an error; people have trouble fixing
1707 .Xdefaults with Emacs, when it has something bad in it. */
1708 type
= FILLED_BOX_CURSOR
;
1714 x_set_cursor_type (f
, arg
, oldval
)
1716 Lisp_Object arg
, oldval
;
1720 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1721 f
->output_data
.x
->cursor_width
= width
;
1723 /* Make sure the cursor gets redrawn. This is overkill, but how
1724 often do people change cursor types? */
1725 update_mode_lines
++;
1729 x_set_icon_type (f
, arg
, oldval
)
1731 Lisp_Object arg
, oldval
;
1737 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1740 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1745 result
= x_text_icon (f
,
1746 (char *) XSTRING ((!NILP (f
->icon_name
)
1750 result
= x_bitmap_icon (f
, arg
);
1755 error ("No icon window available");
1758 XFlush (FRAME_X_DISPLAY (f
));
1762 /* Return non-nil if frame F wants a bitmap icon. */
1770 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1778 x_set_icon_name (f
, arg
, oldval
)
1780 Lisp_Object arg
, oldval
;
1786 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1789 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1794 if (f
->output_data
.x
->icon_bitmap
!= 0)
1799 result
= x_text_icon (f
,
1800 (char *) XSTRING ((!NILP (f
->icon_name
)
1809 error ("No icon window available");
1812 XFlush (FRAME_X_DISPLAY (f
));
1817 x_set_font (f
, arg
, oldval
)
1819 Lisp_Object arg
, oldval
;
1822 Lisp_Object fontset_name
;
1825 CHECK_STRING (arg
, 1);
1827 fontset_name
= Fquery_fontset (arg
, Qnil
);
1830 result
= (STRINGP (fontset_name
)
1831 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1832 : x_new_font (f
, XSTRING (arg
)->data
));
1835 if (EQ (result
, Qnil
))
1836 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1837 else if (EQ (result
, Qt
))
1838 error ("The characters of the given font have varying widths");
1839 else if (STRINGP (result
))
1841 store_frame_param (f
, Qfont
, result
);
1842 recompute_basic_faces (f
);
1847 do_pending_window_change (0);
1849 /* Don't call `face-set-after-frame-default' when faces haven't been
1850 initialized yet. This is the case when called from
1851 Fx_create_frame. In that case, the X widget or window doesn't
1852 exist either, and we can end up in x_report_frame_params with a
1853 null widget which gives a segfault. */
1854 if (FRAME_FACE_CACHE (f
))
1856 XSETFRAME (frame
, f
);
1857 call1 (Qface_set_after_frame_default
, frame
);
1862 x_set_border_width (f
, arg
, oldval
)
1864 Lisp_Object arg
, oldval
;
1866 CHECK_NUMBER (arg
, 0);
1868 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1871 if (FRAME_X_WINDOW (f
) != 0)
1872 error ("Cannot change the border width of a window");
1874 f
->output_data
.x
->border_width
= XINT (arg
);
1878 x_set_internal_border_width (f
, arg
, oldval
)
1880 Lisp_Object arg
, oldval
;
1882 int old
= f
->output_data
.x
->internal_border_width
;
1884 CHECK_NUMBER (arg
, 0);
1885 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1886 if (f
->output_data
.x
->internal_border_width
< 0)
1887 f
->output_data
.x
->internal_border_width
= 0;
1889 #ifdef USE_X_TOOLKIT
1890 if (f
->output_data
.x
->edit_widget
)
1891 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1894 if (f
->output_data
.x
->internal_border_width
== old
)
1897 if (FRAME_X_WINDOW (f
) != 0)
1899 x_set_window_size (f
, 0, f
->width
, f
->height
);
1900 SET_FRAME_GARBAGED (f
);
1901 do_pending_window_change (0);
1906 x_set_visibility (f
, value
, oldval
)
1908 Lisp_Object value
, oldval
;
1911 XSETFRAME (frame
, f
);
1914 Fmake_frame_invisible (frame
, Qt
);
1915 else if (EQ (value
, Qicon
))
1916 Ficonify_frame (frame
);
1918 Fmake_frame_visible (frame
);
1922 /* Change window heights in windows rooted in WINDOW by N lines. */
1925 x_change_window_heights (window
, n
)
1929 struct window
*w
= XWINDOW (window
);
1931 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1932 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1934 if (INTEGERP (w
->orig_top
))
1935 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1936 if (INTEGERP (w
->orig_height
))
1937 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1939 /* Handle just the top child in a vertical split. */
1940 if (!NILP (w
->vchild
))
1941 x_change_window_heights (w
->vchild
, n
);
1943 /* Adjust all children in a horizontal split. */
1944 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1946 w
= XWINDOW (window
);
1947 x_change_window_heights (window
, n
);
1952 x_set_menu_bar_lines (f
, value
, oldval
)
1954 Lisp_Object value
, oldval
;
1957 #ifndef USE_X_TOOLKIT
1958 int olines
= FRAME_MENU_BAR_LINES (f
);
1961 /* Right now, menu bars don't work properly in minibuf-only frames;
1962 most of the commands try to apply themselves to the minibuffer
1963 frame itself, and get an error because you can't switch buffers
1964 in or split the minibuffer window. */
1965 if (FRAME_MINIBUF_ONLY_P (f
))
1968 if (INTEGERP (value
))
1969 nlines
= XINT (value
);
1973 /* Make sure we redisplay all windows in this frame. */
1974 windows_or_buffers_changed
++;
1976 #ifdef USE_X_TOOLKIT
1977 FRAME_MENU_BAR_LINES (f
) = 0;
1980 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1981 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1982 /* Make sure next redisplay shows the menu bar. */
1983 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1987 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1988 free_frame_menubar (f
);
1989 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1991 f
->output_data
.x
->menubar_widget
= 0;
1993 #else /* not USE_X_TOOLKIT */
1994 FRAME_MENU_BAR_LINES (f
) = nlines
;
1995 x_change_window_heights (f
->root_window
, nlines
- olines
);
1996 #endif /* not USE_X_TOOLKIT */
2001 /* Set the number of lines used for the tool bar of frame F to VALUE.
2002 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2003 is the old number of tool bar lines. This function changes the
2004 height of all windows on frame F to match the new tool bar height.
2005 The frame's height doesn't change. */
2008 x_set_tool_bar_lines (f
, value
, oldval
)
2010 Lisp_Object value
, oldval
;
2012 int delta
, nlines
, root_height
;
2013 Lisp_Object root_window
;
2015 /* Use VALUE only if an integer >= 0. */
2016 if (INTEGERP (value
) && XINT (value
) >= 0)
2017 nlines
= XFASTINT (value
);
2021 /* Make sure we redisplay all windows in this frame. */
2022 ++windows_or_buffers_changed
;
2024 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2026 /* Don't resize the tool-bar to more than we have room for. */
2027 root_window
= FRAME_ROOT_WINDOW (f
);
2028 root_height
= XINT (XWINDOW (root_window
)->height
);
2029 if (root_height
- delta
< 1)
2031 delta
= root_height
- 1;
2032 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2035 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2036 x_change_window_heights (root_window
, delta
);
2041 /* Set the foreground color for scroll bars on frame F to VALUE.
2042 VALUE should be a string, a color name. If it isn't a string or
2043 isn't a valid color name, do nothing. OLDVAL is the old value of
2044 the frame parameter. */
2047 x_set_scroll_bar_foreground (f
, value
, oldval
)
2049 Lisp_Object value
, oldval
;
2051 unsigned long pixel
;
2053 if (STRINGP (value
))
2054 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2058 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2059 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2061 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2062 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2064 /* Remove all scroll bars because they have wrong colors. */
2065 if (condemn_scroll_bars_hook
)
2066 (*condemn_scroll_bars_hook
) (f
);
2067 if (judge_scroll_bars_hook
)
2068 (*judge_scroll_bars_hook
) (f
);
2070 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2076 /* Set the background color for scroll bars on frame F to VALUE VALUE
2077 should be a string, a color name. If it isn't a string or isn't a
2078 valid color name, do nothing. OLDVAL is the old value of the frame
2082 x_set_scroll_bar_background (f
, value
, oldval
)
2084 Lisp_Object value
, oldval
;
2086 unsigned long pixel
;
2088 if (STRINGP (value
))
2089 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2093 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2094 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2096 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2097 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2099 /* Remove all scroll bars because they have wrong colors. */
2100 if (condemn_scroll_bars_hook
)
2101 (*condemn_scroll_bars_hook
) (f
);
2102 if (judge_scroll_bars_hook
)
2103 (*judge_scroll_bars_hook
) (f
);
2105 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2111 /* Encode Lisp string STRING as a text in a format appropriate for
2112 XICCC (X Inter Client Communication Conventions).
2114 If STRING contains only ASCII characters, do no conversion and
2115 return the string data of STRING. Otherwise, encode the text by
2116 CODING_SYSTEM, and return a newly allocated memory area which
2117 should be freed by `xfree' by a caller.
2119 Store the byte length of resulting text in *TEXT_BYTES.
2121 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2122 which means that the `encoding' of the result can be `STRING'.
2123 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2124 the result should be `COMPOUND_TEXT'. */
2127 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2128 Lisp_Object string
, coding_system
;
2129 int *text_bytes
, *stringp
;
2131 unsigned char *str
= XSTRING (string
)->data
;
2132 int chars
= XSTRING (string
)->size
;
2133 int bytes
= STRING_BYTES (XSTRING (string
));
2137 struct coding_system coding
;
2139 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2140 if (charset_info
== 0)
2142 /* No multibyte character in OBJ. We need not encode it. */
2143 *text_bytes
= bytes
;
2148 setup_coding_system (coding_system
, &coding
);
2149 coding
.src_multibyte
= 1;
2150 coding
.dst_multibyte
= 0;
2151 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2152 if (coding
.type
== coding_type_iso2022
)
2153 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2154 bufsize
= encoding_buffer_size (&coding
, bytes
);
2155 buf
= (unsigned char *) xmalloc (bufsize
);
2156 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2157 *text_bytes
= coding
.produced
;
2158 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2163 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2166 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2167 name; if NAME is a string, set F's name to NAME and set
2168 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2170 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2171 suggesting a new name, which lisp code should override; if
2172 F->explicit_name is set, ignore the new name; otherwise, set it. */
2175 x_set_name (f
, name
, explicit)
2180 /* Make sure that requests from lisp code override requests from
2181 Emacs redisplay code. */
2184 /* If we're switching from explicit to implicit, we had better
2185 update the mode lines and thereby update the title. */
2186 if (f
->explicit_name
&& NILP (name
))
2187 update_mode_lines
= 1;
2189 f
->explicit_name
= ! NILP (name
);
2191 else if (f
->explicit_name
)
2194 /* If NAME is nil, set the name to the x_id_name. */
2197 /* Check for no change needed in this very common case
2198 before we do any consing. */
2199 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2200 XSTRING (f
->name
)->data
))
2202 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2205 CHECK_STRING (name
, 0);
2207 /* Don't change the name if it's already NAME. */
2208 if (! NILP (Fstring_equal (name
, f
->name
)))
2213 /* For setting the frame title, the title parameter should override
2214 the name parameter. */
2215 if (! NILP (f
->title
))
2218 if (FRAME_X_WINDOW (f
))
2223 XTextProperty text
, icon
;
2225 Lisp_Object coding_system
;
2227 coding_system
= Vlocale_coding_system
;
2228 if (NILP (coding_system
))
2229 coding_system
= Qcompound_text
;
2230 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2231 text
.encoding
= (stringp
? XA_STRING
2232 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2234 text
.nitems
= bytes
;
2236 if (NILP (f
->icon_name
))
2242 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2244 icon
.encoding
= (stringp
? XA_STRING
2245 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2247 icon
.nitems
= bytes
;
2249 #ifdef USE_X_TOOLKIT
2250 XSetWMName (FRAME_X_DISPLAY (f
),
2251 XtWindow (f
->output_data
.x
->widget
), &text
);
2252 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2254 #else /* not USE_X_TOOLKIT */
2255 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2256 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2257 #endif /* not USE_X_TOOLKIT */
2258 if (!NILP (f
->icon_name
)
2259 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2261 if (text
.value
!= XSTRING (name
)->data
)
2264 #else /* not HAVE_X11R4 */
2265 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2266 XSTRING (name
)->data
);
2267 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2268 XSTRING (name
)->data
);
2269 #endif /* not HAVE_X11R4 */
2274 /* This function should be called when the user's lisp code has
2275 specified a name for the frame; the name will override any set by the
2278 x_explicitly_set_name (f
, arg
, oldval
)
2280 Lisp_Object arg
, oldval
;
2282 x_set_name (f
, arg
, 1);
2285 /* This function should be called by Emacs redisplay code to set the
2286 name; names set this way will never override names set by the user's
2289 x_implicitly_set_name (f
, arg
, oldval
)
2291 Lisp_Object arg
, oldval
;
2293 x_set_name (f
, arg
, 0);
2296 /* Change the title of frame F to NAME.
2297 If NAME is nil, use the frame name as the title.
2299 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2300 name; if NAME is a string, set F's name to NAME and set
2301 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2303 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2304 suggesting a new name, which lisp code should override; if
2305 F->explicit_name is set, ignore the new name; otherwise, set it. */
2308 x_set_title (f
, name
, old_name
)
2310 Lisp_Object name
, old_name
;
2312 /* Don't change the title if it's already NAME. */
2313 if (EQ (name
, f
->title
))
2316 update_mode_lines
= 1;
2323 CHECK_STRING (name
, 0);
2325 if (FRAME_X_WINDOW (f
))
2330 XTextProperty text
, icon
;
2332 Lisp_Object coding_system
;
2334 coding_system
= Vlocale_coding_system
;
2335 if (NILP (coding_system
))
2336 coding_system
= Qcompound_text
;
2337 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2338 text
.encoding
= (stringp
? XA_STRING
2339 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2341 text
.nitems
= bytes
;
2343 if (NILP (f
->icon_name
))
2349 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2351 icon
.encoding
= (stringp
? XA_STRING
2352 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2354 icon
.nitems
= bytes
;
2356 #ifdef USE_X_TOOLKIT
2357 XSetWMName (FRAME_X_DISPLAY (f
),
2358 XtWindow (f
->output_data
.x
->widget
), &text
);
2359 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2361 #else /* not USE_X_TOOLKIT */
2362 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2363 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2364 #endif /* not USE_X_TOOLKIT */
2365 if (!NILP (f
->icon_name
)
2366 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2368 if (text
.value
!= XSTRING (name
)->data
)
2371 #else /* not HAVE_X11R4 */
2372 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2373 XSTRING (name
)->data
);
2374 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2375 XSTRING (name
)->data
);
2376 #endif /* not HAVE_X11R4 */
2382 x_set_autoraise (f
, arg
, oldval
)
2384 Lisp_Object arg
, oldval
;
2386 f
->auto_raise
= !EQ (Qnil
, arg
);
2390 x_set_autolower (f
, arg
, oldval
)
2392 Lisp_Object arg
, oldval
;
2394 f
->auto_lower
= !EQ (Qnil
, arg
);
2398 x_set_unsplittable (f
, arg
, oldval
)
2400 Lisp_Object arg
, oldval
;
2402 f
->no_split
= !NILP (arg
);
2406 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2408 Lisp_Object arg
, oldval
;
2410 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2411 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2412 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2413 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2415 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2417 ? vertical_scroll_bar_none
2419 ? vertical_scroll_bar_right
2420 : vertical_scroll_bar_left
);
2422 /* We set this parameter before creating the X window for the
2423 frame, so we can get the geometry right from the start.
2424 However, if the window hasn't been created yet, we shouldn't
2425 call x_set_window_size. */
2426 if (FRAME_X_WINDOW (f
))
2427 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2428 do_pending_window_change (0);
2433 x_set_scroll_bar_width (f
, arg
, oldval
)
2435 Lisp_Object arg
, oldval
;
2437 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2441 #ifdef USE_TOOLKIT_SCROLL_BARS
2442 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2443 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2444 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2445 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2447 /* Make the actual width at least 14 pixels and a multiple of a
2449 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2451 /* Use all of that space (aside from required margins) for the
2453 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2456 if (FRAME_X_WINDOW (f
))
2457 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2458 do_pending_window_change (0);
2460 else if (INTEGERP (arg
) && XINT (arg
) > 0
2461 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2463 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2464 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2466 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2467 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2468 if (FRAME_X_WINDOW (f
))
2469 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2472 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2473 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2474 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2479 /* Subroutines of creating an X frame. */
2481 /* Make sure that Vx_resource_name is set to a reasonable value.
2482 Fix it up, or set it to `emacs' if it is too hopeless. */
2485 validate_x_resource_name ()
2488 /* Number of valid characters in the resource name. */
2490 /* Number of invalid characters in the resource name. */
2495 if (!STRINGP (Vx_resource_class
))
2496 Vx_resource_class
= build_string (EMACS_CLASS
);
2498 if (STRINGP (Vx_resource_name
))
2500 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2503 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2505 /* Only letters, digits, - and _ are valid in resource names.
2506 Count the valid characters and count the invalid ones. */
2507 for (i
= 0; i
< len
; i
++)
2510 if (! ((c
>= 'a' && c
<= 'z')
2511 || (c
>= 'A' && c
<= 'Z')
2512 || (c
>= '0' && c
<= '9')
2513 || c
== '-' || c
== '_'))
2520 /* Not a string => completely invalid. */
2521 bad_count
= 5, good_count
= 0;
2523 /* If name is valid already, return. */
2527 /* If name is entirely invalid, or nearly so, use `emacs'. */
2529 || (good_count
== 1 && bad_count
> 0))
2531 Vx_resource_name
= build_string ("emacs");
2535 /* Name is partly valid. Copy it and replace the invalid characters
2536 with underscores. */
2538 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2540 for (i
= 0; i
< len
; i
++)
2542 int c
= XSTRING (new)->data
[i
];
2543 if (! ((c
>= 'a' && c
<= 'z')
2544 || (c
>= 'A' && c
<= 'Z')
2545 || (c
>= '0' && c
<= '9')
2546 || c
== '-' || c
== '_'))
2547 XSTRING (new)->data
[i
] = '_';
2552 extern char *x_get_string_resource ();
2554 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2555 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2556 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2557 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2558 the name specified by the `-name' or `-rn' command-line arguments.\n\
2560 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2561 class, respectively. You must specify both of them or neither.\n\
2562 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2563 and the class is `Emacs.CLASS.SUBCLASS'.")
2564 (attribute
, class, component
, subclass
)
2565 Lisp_Object attribute
, class, component
, subclass
;
2567 register char *value
;
2573 CHECK_STRING (attribute
, 0);
2574 CHECK_STRING (class, 0);
2576 if (!NILP (component
))
2577 CHECK_STRING (component
, 1);
2578 if (!NILP (subclass
))
2579 CHECK_STRING (subclass
, 2);
2580 if (NILP (component
) != NILP (subclass
))
2581 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2583 validate_x_resource_name ();
2585 /* Allocate space for the components, the dots which separate them,
2586 and the final '\0'. Make them big enough for the worst case. */
2587 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2588 + (STRINGP (component
)
2589 ? STRING_BYTES (XSTRING (component
)) : 0)
2590 + STRING_BYTES (XSTRING (attribute
))
2593 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2594 + STRING_BYTES (XSTRING (class))
2595 + (STRINGP (subclass
)
2596 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2599 /* Start with emacs.FRAMENAME for the name (the specific one)
2600 and with `Emacs' for the class key (the general one). */
2601 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2602 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2604 strcat (class_key
, ".");
2605 strcat (class_key
, XSTRING (class)->data
);
2607 if (!NILP (component
))
2609 strcat (class_key
, ".");
2610 strcat (class_key
, XSTRING (subclass
)->data
);
2612 strcat (name_key
, ".");
2613 strcat (name_key
, XSTRING (component
)->data
);
2616 strcat (name_key
, ".");
2617 strcat (name_key
, XSTRING (attribute
)->data
);
2619 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2620 name_key
, class_key
);
2622 if (value
!= (char *) 0)
2623 return build_string (value
);
2628 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2631 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2632 struct x_display_info
*dpyinfo
;
2633 Lisp_Object attribute
, class, component
, subclass
;
2635 register char *value
;
2639 CHECK_STRING (attribute
, 0);
2640 CHECK_STRING (class, 0);
2642 if (!NILP (component
))
2643 CHECK_STRING (component
, 1);
2644 if (!NILP (subclass
))
2645 CHECK_STRING (subclass
, 2);
2646 if (NILP (component
) != NILP (subclass
))
2647 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2649 validate_x_resource_name ();
2651 /* Allocate space for the components, the dots which separate them,
2652 and the final '\0'. Make them big enough for the worst case. */
2653 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2654 + (STRINGP (component
)
2655 ? STRING_BYTES (XSTRING (component
)) : 0)
2656 + STRING_BYTES (XSTRING (attribute
))
2659 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2660 + STRING_BYTES (XSTRING (class))
2661 + (STRINGP (subclass
)
2662 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2665 /* Start with emacs.FRAMENAME for the name (the specific one)
2666 and with `Emacs' for the class key (the general one). */
2667 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2668 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2670 strcat (class_key
, ".");
2671 strcat (class_key
, XSTRING (class)->data
);
2673 if (!NILP (component
))
2675 strcat (class_key
, ".");
2676 strcat (class_key
, XSTRING (subclass
)->data
);
2678 strcat (name_key
, ".");
2679 strcat (name_key
, XSTRING (component
)->data
);
2682 strcat (name_key
, ".");
2683 strcat (name_key
, XSTRING (attribute
)->data
);
2685 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2687 if (value
!= (char *) 0)
2688 return build_string (value
);
2693 /* Used when C code wants a resource value. */
2696 x_get_resource_string (attribute
, class)
2697 char *attribute
, *class;
2701 struct frame
*sf
= SELECTED_FRAME ();
2703 /* Allocate space for the components, the dots which separate them,
2704 and the final '\0'. */
2705 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2706 + strlen (attribute
) + 2);
2707 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2708 + strlen (class) + 2);
2710 sprintf (name_key
, "%s.%s",
2711 XSTRING (Vinvocation_name
)->data
,
2713 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2715 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2716 name_key
, class_key
);
2719 /* Types we might convert a resource string into. */
2729 /* Return the value of parameter PARAM.
2731 First search ALIST, then Vdefault_frame_alist, then the X defaults
2732 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2734 Convert the resource to the type specified by desired_type.
2736 If no default is specified, return Qunbound. If you call
2737 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2738 and don't let it get stored in any Lisp-visible variables! */
2741 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2742 struct x_display_info
*dpyinfo
;
2743 Lisp_Object alist
, param
;
2746 enum resource_types type
;
2748 register Lisp_Object tem
;
2750 tem
= Fassq (param
, alist
);
2752 tem
= Fassq (param
, Vdefault_frame_alist
);
2758 tem
= display_x_get_resource (dpyinfo
,
2759 build_string (attribute
),
2760 build_string (class),
2768 case RES_TYPE_NUMBER
:
2769 return make_number (atoi (XSTRING (tem
)->data
));
2771 case RES_TYPE_FLOAT
:
2772 return make_float (atof (XSTRING (tem
)->data
));
2774 case RES_TYPE_BOOLEAN
:
2775 tem
= Fdowncase (tem
);
2776 if (!strcmp (XSTRING (tem
)->data
, "on")
2777 || !strcmp (XSTRING (tem
)->data
, "true"))
2782 case RES_TYPE_STRING
:
2785 case RES_TYPE_SYMBOL
:
2786 /* As a special case, we map the values `true' and `on'
2787 to Qt, and `false' and `off' to Qnil. */
2790 lower
= Fdowncase (tem
);
2791 if (!strcmp (XSTRING (lower
)->data
, "on")
2792 || !strcmp (XSTRING (lower
)->data
, "true"))
2794 else if (!strcmp (XSTRING (lower
)->data
, "off")
2795 || !strcmp (XSTRING (lower
)->data
, "false"))
2798 return Fintern (tem
, Qnil
);
2811 /* Like x_get_arg, but also record the value in f->param_alist. */
2814 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2816 Lisp_Object alist
, param
;
2819 enum resource_types type
;
2823 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2824 attribute
, class, type
);
2826 store_frame_param (f
, param
, value
);
2831 /* Record in frame F the specified or default value according to ALIST
2832 of the parameter named PROP (a Lisp symbol).
2833 If no value is specified for PROP, look for an X default for XPROP
2834 on the frame named NAME.
2835 If that is not found either, use the value DEFLT. */
2838 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2845 enum resource_types type
;
2849 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2850 if (EQ (tem
, Qunbound
))
2852 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2857 /* Record in frame F the specified or default value according to ALIST
2858 of the parameter named PROP (a Lisp symbol). If no value is
2859 specified for PROP, look for an X default for XPROP on the frame
2860 named NAME. If that is not found either, use the value DEFLT. */
2863 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2872 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2875 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2876 if (EQ (tem
, Qunbound
))
2878 #ifdef USE_TOOLKIT_SCROLL_BARS
2880 /* See if an X resource for the scroll bar color has been
2882 tem
= display_x_get_resource (dpyinfo
,
2883 build_string (foreground_p
2887 build_string ("verticalScrollBar"),
2891 /* If nothing has been specified, scroll bars will use a
2892 toolkit-dependent default. Because these defaults are
2893 difficult to get at without actually creating a scroll
2894 bar, use nil to indicate that no color has been
2899 #else /* not USE_TOOLKIT_SCROLL_BARS */
2903 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2906 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2912 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2913 "Parse an X-style geometry string STRING.\n\
2914 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2915 The properties returned may include `top', `left', `height', and `width'.\n\
2916 The value of `left' or `top' may be an integer,\n\
2917 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2918 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2923 unsigned int width
, height
;
2926 CHECK_STRING (string
, 0);
2928 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2929 &x
, &y
, &width
, &height
);
2932 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2933 error ("Must specify both x and y position, or neither");
2937 if (geometry
& XValue
)
2939 Lisp_Object element
;
2941 if (x
>= 0 && (geometry
& XNegative
))
2942 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2943 else if (x
< 0 && ! (geometry
& XNegative
))
2944 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2946 element
= Fcons (Qleft
, make_number (x
));
2947 result
= Fcons (element
, result
);
2950 if (geometry
& YValue
)
2952 Lisp_Object element
;
2954 if (y
>= 0 && (geometry
& YNegative
))
2955 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2956 else if (y
< 0 && ! (geometry
& YNegative
))
2957 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2959 element
= Fcons (Qtop
, make_number (y
));
2960 result
= Fcons (element
, result
);
2963 if (geometry
& WidthValue
)
2964 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2965 if (geometry
& HeightValue
)
2966 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2971 /* Calculate the desired size and position of this window,
2972 and return the flags saying which aspects were specified.
2974 This function does not make the coordinates positive. */
2976 #define DEFAULT_ROWS 40
2977 #define DEFAULT_COLS 80
2980 x_figure_window_size (f
, parms
)
2984 register Lisp_Object tem0
, tem1
, tem2
;
2985 long window_prompting
= 0;
2986 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2988 /* Default values if we fall through.
2989 Actually, if that happens we should get
2990 window manager prompting. */
2991 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2992 f
->height
= DEFAULT_ROWS
;
2993 /* Window managers expect that if program-specified
2994 positions are not (0,0), they're intentional, not defaults. */
2995 f
->output_data
.x
->top_pos
= 0;
2996 f
->output_data
.x
->left_pos
= 0;
2998 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2999 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3000 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3001 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3003 if (!EQ (tem0
, Qunbound
))
3005 CHECK_NUMBER (tem0
, 0);
3006 f
->height
= XINT (tem0
);
3008 if (!EQ (tem1
, Qunbound
))
3010 CHECK_NUMBER (tem1
, 0);
3011 SET_FRAME_WIDTH (f
, XINT (tem1
));
3013 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3014 window_prompting
|= USSize
;
3016 window_prompting
|= PSize
;
3019 f
->output_data
.x
->vertical_scroll_bar_extra
3020 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3022 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3023 f
->output_data
.x
->flags_areas_extra
3024 = FRAME_FLAGS_AREA_WIDTH (f
);
3025 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3026 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3028 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3029 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3030 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3031 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3033 if (EQ (tem0
, Qminus
))
3035 f
->output_data
.x
->top_pos
= 0;
3036 window_prompting
|= YNegative
;
3038 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3039 && CONSP (XCDR (tem0
))
3040 && INTEGERP (XCAR (XCDR (tem0
))))
3042 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3043 window_prompting
|= YNegative
;
3045 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3046 && CONSP (XCDR (tem0
))
3047 && INTEGERP (XCAR (XCDR (tem0
))))
3049 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3051 else if (EQ (tem0
, Qunbound
))
3052 f
->output_data
.x
->top_pos
= 0;
3055 CHECK_NUMBER (tem0
, 0);
3056 f
->output_data
.x
->top_pos
= XINT (tem0
);
3057 if (f
->output_data
.x
->top_pos
< 0)
3058 window_prompting
|= YNegative
;
3061 if (EQ (tem1
, Qminus
))
3063 f
->output_data
.x
->left_pos
= 0;
3064 window_prompting
|= XNegative
;
3066 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3067 && CONSP (XCDR (tem1
))
3068 && INTEGERP (XCAR (XCDR (tem1
))))
3070 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3071 window_prompting
|= XNegative
;
3073 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3074 && CONSP (XCDR (tem1
))
3075 && INTEGERP (XCAR (XCDR (tem1
))))
3077 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3079 else if (EQ (tem1
, Qunbound
))
3080 f
->output_data
.x
->left_pos
= 0;
3083 CHECK_NUMBER (tem1
, 0);
3084 f
->output_data
.x
->left_pos
= XINT (tem1
);
3085 if (f
->output_data
.x
->left_pos
< 0)
3086 window_prompting
|= XNegative
;
3089 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3090 window_prompting
|= USPosition
;
3092 window_prompting
|= PPosition
;
3095 return window_prompting
;
3098 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3101 XSetWMProtocols (dpy
, w
, protocols
, count
)
3108 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3109 if (prop
== None
) return False
;
3110 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3111 (unsigned char *) protocols
, count
);
3114 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3116 #ifdef USE_X_TOOLKIT
3118 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3119 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3120 already be present because of the toolkit (Motif adds some of them,
3121 for example, but Xt doesn't). */
3124 hack_wm_protocols (f
, widget
)
3128 Display
*dpy
= XtDisplay (widget
);
3129 Window w
= XtWindow (widget
);
3130 int need_delete
= 1;
3136 Atom type
, *atoms
= 0;
3138 unsigned long nitems
= 0;
3139 unsigned long bytes_after
;
3141 if ((XGetWindowProperty (dpy
, w
,
3142 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3143 (long)0, (long)100, False
, XA_ATOM
,
3144 &type
, &format
, &nitems
, &bytes_after
,
3145 (unsigned char **) &atoms
)
3147 && format
== 32 && type
== XA_ATOM
)
3151 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3153 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3155 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3158 if (atoms
) XFree ((char *) atoms
);
3164 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3166 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3168 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3170 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3171 XA_ATOM
, 32, PropModeAppend
,
3172 (unsigned char *) props
, count
);
3180 /* Support routines for XIC (X Input Context). */
3184 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3185 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3188 /* Supported XIM styles, ordered by preferenc. */
3190 static XIMStyle supported_xim_styles
[] =
3192 XIMPreeditPosition
| XIMStatusArea
,
3193 XIMPreeditPosition
| XIMStatusNothing
,
3194 XIMPreeditPosition
| XIMStatusNone
,
3195 XIMPreeditNothing
| XIMStatusArea
,
3196 XIMPreeditNothing
| XIMStatusNothing
,
3197 XIMPreeditNothing
| XIMStatusNone
,
3198 XIMPreeditNone
| XIMStatusArea
,
3199 XIMPreeditNone
| XIMStatusNothing
,
3200 XIMPreeditNone
| XIMStatusNone
,
3205 /* Create an X fontset on frame F with base font name
3209 xic_create_xfontset (f
, base_fontname
)
3211 char *base_fontname
;
3214 char **missing_list
;
3218 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3219 base_fontname
, &missing_list
,
3220 &missing_count
, &def_string
);
3222 XFreeStringList (missing_list
);
3224 /* No need to free def_string. */
3229 /* Value is the best input style, given user preferences USER (already
3230 checked to be supported by Emacs), and styles supported by the
3231 input method XIM. */
3234 best_xim_style (user
, xim
)
3240 for (i
= 0; i
< user
->count_styles
; ++i
)
3241 for (j
= 0; j
< xim
->count_styles
; ++j
)
3242 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3243 return user
->supported_styles
[i
];
3245 /* Return the default style. */
3246 return XIMPreeditNothing
| XIMStatusNothing
;
3249 /* Create XIC for frame F. */
3252 create_frame_xic (f
)
3257 XFontSet xfs
= NULL
;
3258 static XIMStyle xic_style
;
3263 xim
= FRAME_X_XIM (f
);
3268 XVaNestedList preedit_attr
;
3269 XVaNestedList status_attr
;
3270 char *base_fontname
;
3273 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3274 spot
.x
= 0; spot
.y
= 1;
3275 /* Create X fontset. */
3276 fontset
= FRAME_FONTSET (f
);
3278 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3281 /* Determine the base fontname from the ASCII font name of
3283 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3284 char *p
= ascii_font
;
3287 for (i
= 0; *p
; p
++)
3290 /* As the font name doesn't conform to XLFD, we can't
3291 modify it to get a suitable base fontname for the
3293 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3296 int len
= strlen (ascii_font
) + 1;
3299 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3308 base_fontname
= (char *) alloca (len
);
3309 bzero (base_fontname
, len
);
3310 strcpy (base_fontname
, "-*-*-");
3311 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3312 strcat (base_fontname
, "*-*-*-*-*-*-*");
3315 xfs
= xic_create_xfontset (f
, base_fontname
);
3317 /* Determine XIC style. */
3320 XIMStyles supported_list
;
3321 supported_list
.count_styles
= (sizeof supported_xim_styles
3322 / sizeof supported_xim_styles
[0]);
3323 supported_list
.supported_styles
= supported_xim_styles
;
3324 xic_style
= best_xim_style (&supported_list
,
3325 FRAME_X_XIM_STYLES (f
));
3328 preedit_attr
= XVaCreateNestedList (0,
3331 FRAME_FOREGROUND_PIXEL (f
),
3333 FRAME_BACKGROUND_PIXEL (f
),
3334 (xic_style
& XIMPreeditPosition
3339 status_attr
= XVaCreateNestedList (0,
3345 FRAME_FOREGROUND_PIXEL (f
),
3347 FRAME_BACKGROUND_PIXEL (f
),
3350 xic
= XCreateIC (xim
,
3351 XNInputStyle
, xic_style
,
3352 XNClientWindow
, FRAME_X_WINDOW(f
),
3353 XNFocusWindow
, FRAME_X_WINDOW(f
),
3354 XNStatusAttributes
, status_attr
,
3355 XNPreeditAttributes
, preedit_attr
,
3357 XFree (preedit_attr
);
3358 XFree (status_attr
);
3361 FRAME_XIC (f
) = xic
;
3362 FRAME_XIC_STYLE (f
) = xic_style
;
3363 FRAME_XIC_FONTSET (f
) = xfs
;
3367 /* Destroy XIC and free XIC fontset of frame F, if any. */
3373 if (FRAME_XIC (f
) == NULL
)
3376 XDestroyIC (FRAME_XIC (f
));
3377 if (FRAME_XIC_FONTSET (f
))
3378 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3380 FRAME_XIC (f
) = NULL
;
3381 FRAME_XIC_FONTSET (f
) = NULL
;
3385 /* Place preedit area for XIC of window W's frame to specified
3386 pixel position X/Y. X and Y are relative to window W. */
3389 xic_set_preeditarea (w
, x
, y
)
3393 struct frame
*f
= XFRAME (w
->frame
);
3397 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3398 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3399 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3400 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3405 /* Place status area for XIC in bottom right corner of frame F.. */
3408 xic_set_statusarea (f
)
3411 XIC xic
= FRAME_XIC (f
);
3416 /* Negotiate geometry of status area. If input method has existing
3417 status area, use its current size. */
3418 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3419 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3420 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3423 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3424 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3427 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3429 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3430 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3434 area
.width
= needed
->width
;
3435 area
.height
= needed
->height
;
3436 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3437 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3438 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3441 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3442 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3447 /* Set X fontset for XIC of frame F, using base font name
3448 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3451 xic_set_xfontset (f
, base_fontname
)
3453 char *base_fontname
;
3458 xfs
= xic_create_xfontset (f
, base_fontname
);
3460 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3461 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3462 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3463 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3464 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3467 if (FRAME_XIC_FONTSET (f
))
3468 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3469 FRAME_XIC_FONTSET (f
) = xfs
;
3472 #endif /* HAVE_X_I18N */
3476 #ifdef USE_X_TOOLKIT
3478 /* Create and set up the X widget for frame F. */
3481 x_window (f
, window_prompting
, minibuffer_only
)
3483 long window_prompting
;
3484 int minibuffer_only
;
3486 XClassHint class_hints
;
3487 XSetWindowAttributes attributes
;
3488 unsigned long attribute_mask
;
3489 Widget shell_widget
;
3491 Widget frame_widget
;
3497 /* Use the resource name as the top-level widget name
3498 for looking up resources. Make a non-Lisp copy
3499 for the window manager, so GC relocation won't bother it.
3501 Elsewhere we specify the window name for the window manager. */
3504 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3505 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3506 strcpy (f
->namebuf
, str
);
3510 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3511 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3512 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3513 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3514 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3515 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3516 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3517 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3518 applicationShellWidgetClass
,
3519 FRAME_X_DISPLAY (f
), al
, ac
);
3521 f
->output_data
.x
->widget
= shell_widget
;
3522 /* maybe_set_screen_title_format (shell_widget); */
3524 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3525 (widget_value
*) NULL
,
3526 shell_widget
, False
,
3530 (lw_callback
) NULL
);
3533 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3534 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3535 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3536 XtSetValues (pane_widget
, al
, ac
);
3537 f
->output_data
.x
->column_widget
= pane_widget
;
3539 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3540 the emacs screen when changing menubar. This reduces flickering. */
3543 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3544 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3545 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3546 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3547 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3548 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3549 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3550 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3551 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3554 f
->output_data
.x
->edit_widget
= frame_widget
;
3556 XtManageChild (frame_widget
);
3558 /* Do some needed geometry management. */
3561 char *tem
, shell_position
[32];
3564 int extra_borders
= 0;
3566 = (f
->output_data
.x
->menubar_widget
3567 ? (f
->output_data
.x
->menubar_widget
->core
.height
3568 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3571 #if 0 /* Experimentally, we now get the right results
3572 for -geometry -0-0 without this. 24 Aug 96, rms. */
3573 if (FRAME_EXTERNAL_MENU_BAR (f
))
3576 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3577 menubar_size
+= ibw
;
3581 f
->output_data
.x
->menubar_height
= menubar_size
;
3584 /* Motif seems to need this amount added to the sizes
3585 specified for the shell widget. The Athena/Lucid widgets don't.
3586 Both conclusions reached experimentally. -- rms. */
3587 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3588 &extra_borders
, NULL
);
3592 /* Convert our geometry parameters into a geometry string
3594 Note that we do not specify here whether the position
3595 is a user-specified or program-specified one.
3596 We pass that information later, in x_wm_set_size_hints. */
3598 int left
= f
->output_data
.x
->left_pos
;
3599 int xneg
= window_prompting
& XNegative
;
3600 int top
= f
->output_data
.x
->top_pos
;
3601 int yneg
= window_prompting
& YNegative
;
3607 if (window_prompting
& USPosition
)
3608 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3609 PIXEL_WIDTH (f
) + extra_borders
,
3610 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3611 (xneg
? '-' : '+'), left
,
3612 (yneg
? '-' : '+'), top
);
3614 sprintf (shell_position
, "=%dx%d",
3615 PIXEL_WIDTH (f
) + extra_borders
,
3616 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3619 len
= strlen (shell_position
) + 1;
3620 /* We don't free this because we don't know whether
3621 it is safe to free it while the frame exists.
3622 It isn't worth the trouble of arranging to free it
3623 when the frame is deleted. */
3624 tem
= (char *) xmalloc (len
);
3625 strncpy (tem
, shell_position
, len
);
3626 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3627 XtSetValues (shell_widget
, al
, ac
);
3630 XtManageChild (pane_widget
);
3631 XtRealizeWidget (shell_widget
);
3633 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3635 validate_x_resource_name ();
3637 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3638 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3639 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3642 FRAME_XIC (f
) = NULL
;
3644 create_frame_xic (f
);
3648 f
->output_data
.x
->wm_hints
.input
= True
;
3649 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3650 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3651 &f
->output_data
.x
->wm_hints
);
3653 hack_wm_protocols (f
, shell_widget
);
3656 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3659 /* Do a stupid property change to force the server to generate a
3660 PropertyNotify event so that the event_stream server timestamp will
3661 be initialized to something relevant to the time we created the window.
3663 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3664 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3665 XA_ATOM
, 32, PropModeAppend
,
3666 (unsigned char*) NULL
, 0);
3668 /* Make all the standard events reach the Emacs frame. */
3669 attributes
.event_mask
= STANDARD_EVENT_SET
;
3674 /* XIM server might require some X events. */
3675 unsigned long fevent
= NoEventMask
;
3676 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3677 attributes
.event_mask
|= fevent
;
3679 #endif /* HAVE_X_I18N */
3681 attribute_mask
= CWEventMask
;
3682 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3683 attribute_mask
, &attributes
);
3685 XtMapWidget (frame_widget
);
3687 /* x_set_name normally ignores requests to set the name if the
3688 requested name is the same as the current name. This is the one
3689 place where that assumption isn't correct; f->name is set, but
3690 the X server hasn't been told. */
3693 int explicit = f
->explicit_name
;
3695 f
->explicit_name
= 0;
3698 x_set_name (f
, name
, explicit);
3701 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3702 f
->output_data
.x
->text_cursor
);
3706 /* This is a no-op, except under Motif. Make sure main areas are
3707 set to something reasonable, in case we get an error later. */
3708 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3711 #else /* not USE_X_TOOLKIT */
3713 /* Create and set up the X window for frame F. */
3720 XClassHint class_hints
;
3721 XSetWindowAttributes attributes
;
3722 unsigned long attribute_mask
;
3724 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3725 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3726 attributes
.bit_gravity
= StaticGravity
;
3727 attributes
.backing_store
= NotUseful
;
3728 attributes
.save_under
= True
;
3729 attributes
.event_mask
= STANDARD_EVENT_SET
;
3730 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3731 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3736 = XCreateWindow (FRAME_X_DISPLAY (f
),
3737 f
->output_data
.x
->parent_desc
,
3738 f
->output_data
.x
->left_pos
,
3739 f
->output_data
.x
->top_pos
,
3740 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3741 f
->output_data
.x
->border_width
,
3742 CopyFromParent
, /* depth */
3743 InputOutput
, /* class */
3745 attribute_mask
, &attributes
);
3749 create_frame_xic (f
);
3752 /* XIM server might require some X events. */
3753 unsigned long fevent
= NoEventMask
;
3754 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3755 attributes
.event_mask
|= fevent
;
3756 attribute_mask
= CWEventMask
;
3757 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3758 attribute_mask
, &attributes
);
3761 #endif /* HAVE_X_I18N */
3763 validate_x_resource_name ();
3765 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3766 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3767 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3769 /* The menubar is part of the ordinary display;
3770 it does not count in addition to the height of the window. */
3771 f
->output_data
.x
->menubar_height
= 0;
3773 /* This indicates that we use the "Passive Input" input model.
3774 Unless we do this, we don't get the Focus{In,Out} events that we
3775 need to draw the cursor correctly. Accursed bureaucrats.
3776 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3778 f
->output_data
.x
->wm_hints
.input
= True
;
3779 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3780 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3781 &f
->output_data
.x
->wm_hints
);
3782 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3784 /* Request "save yourself" and "delete window" commands from wm. */
3787 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3788 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3789 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3792 /* x_set_name normally ignores requests to set the name if the
3793 requested name is the same as the current name. This is the one
3794 place where that assumption isn't correct; f->name is set, but
3795 the X server hasn't been told. */
3798 int explicit = f
->explicit_name
;
3800 f
->explicit_name
= 0;
3803 x_set_name (f
, name
, explicit);
3806 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3807 f
->output_data
.x
->text_cursor
);
3811 if (FRAME_X_WINDOW (f
) == 0)
3812 error ("Unable to create window");
3815 #endif /* not USE_X_TOOLKIT */
3817 /* Handle the icon stuff for this window. Perhaps later we might
3818 want an x_set_icon_position which can be called interactively as
3826 Lisp_Object icon_x
, icon_y
;
3827 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3829 /* Set the position of the icon. Note that twm groups all
3830 icons in an icon window. */
3831 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3832 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3833 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3835 CHECK_NUMBER (icon_x
, 0);
3836 CHECK_NUMBER (icon_y
, 0);
3838 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3839 error ("Both left and top icon corners of icon must be specified");
3843 if (! EQ (icon_x
, Qunbound
))
3844 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3846 /* Start up iconic or window? */
3847 x_wm_set_window_state
3848 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3853 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3860 /* Make the GCs needed for this window, setting the
3861 background, border and mouse colors; also create the
3862 mouse cursor and the gray border tile. */
3864 static char cursor_bits
[] =
3866 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3867 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3868 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3869 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3876 XGCValues gc_values
;
3880 /* Create the GCs of this frame.
3881 Note that many default values are used. */
3884 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3885 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3886 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3887 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3888 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3890 GCLineWidth
| GCFont
3891 | GCForeground
| GCBackground
,
3894 /* Reverse video style. */
3895 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3896 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3897 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3899 GCFont
| GCForeground
| GCBackground
3903 /* Cursor has cursor-color background, background-color foreground. */
3904 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3905 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3906 gc_values
.fill_style
= FillOpaqueStippled
;
3908 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3909 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3910 cursor_bits
, 16, 16);
3911 f
->output_data
.x
->cursor_gc
3912 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3913 (GCFont
| GCForeground
| GCBackground
3914 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3918 f
->output_data
.x
->white_relief
.gc
= 0;
3919 f
->output_data
.x
->black_relief
.gc
= 0;
3921 /* Create the gray border tile used when the pointer is not in
3922 the frame. Since this depends on the frame's pixel values,
3923 this must be done on a per-frame basis. */
3924 f
->output_data
.x
->border_tile
3925 = (XCreatePixmapFromBitmapData
3926 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3927 gray_bits
, gray_width
, gray_height
,
3928 f
->output_data
.x
->foreground_pixel
,
3929 f
->output_data
.x
->background_pixel
,
3930 DefaultDepth (FRAME_X_DISPLAY (f
),
3931 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3936 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3938 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3939 Returns an Emacs frame object.\n\
3940 ALIST is an alist of frame parameters.\n\
3941 If the parameters specify that the frame should not have a minibuffer,\n\
3942 and do not specify a specific minibuffer window to use,\n\
3943 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3944 be shared by the new frame.\n\
3946 This function is an internal primitive--use `make-frame' instead.")
3951 Lisp_Object frame
, tem
;
3953 int minibuffer_only
= 0;
3954 long window_prompting
= 0;
3956 int count
= specpdl_ptr
- specpdl
;
3957 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3958 Lisp_Object display
;
3959 struct x_display_info
*dpyinfo
= NULL
;
3965 /* Use this general default value to start with
3966 until we know if this frame has a specified name. */
3967 Vx_resource_name
= Vinvocation_name
;
3969 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3970 if (EQ (display
, Qunbound
))
3972 dpyinfo
= check_x_display_info (display
);
3974 kb
= dpyinfo
->kboard
;
3976 kb
= &the_only_kboard
;
3979 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3981 && ! EQ (name
, Qunbound
)
3983 error ("Invalid frame name--not a string or nil");
3986 Vx_resource_name
= name
;
3988 /* See if parent window is specified. */
3989 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3990 if (EQ (parent
, Qunbound
))
3992 if (! NILP (parent
))
3993 CHECK_NUMBER (parent
, 0);
3995 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3996 /* No need to protect DISPLAY because that's not used after passing
3997 it to make_frame_without_minibuffer. */
3999 GCPRO4 (parms
, parent
, name
, frame
);
4000 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4002 if (EQ (tem
, Qnone
) || NILP (tem
))
4003 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4004 else if (EQ (tem
, Qonly
))
4006 f
= make_minibuffer_frame ();
4007 minibuffer_only
= 1;
4009 else if (WINDOWP (tem
))
4010 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4014 XSETFRAME (frame
, f
);
4016 /* Note that X Windows does support scroll bars. */
4017 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4019 f
->output_method
= output_x_window
;
4020 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4021 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4022 f
->output_data
.x
->icon_bitmap
= -1;
4023 f
->output_data
.x
->fontset
= -1;
4024 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4025 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4028 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4030 if (! STRINGP (f
->icon_name
))
4031 f
->icon_name
= Qnil
;
4033 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4035 FRAME_KBOARD (f
) = kb
;
4038 /* These colors will be set anyway later, but it's important
4039 to get the color reference counts right, so initialize them! */
4042 struct gcpro gcpro1
;
4044 black
= build_string ("black");
4046 f
->output_data
.x
->foreground_pixel
4047 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4048 f
->output_data
.x
->background_pixel
4049 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4050 f
->output_data
.x
->cursor_pixel
4051 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4052 f
->output_data
.x
->cursor_foreground_pixel
4053 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4054 f
->output_data
.x
->border_pixel
4055 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4056 f
->output_data
.x
->mouse_pixel
4057 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4061 /* Specify the parent under which to make this X window. */
4065 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4066 f
->output_data
.x
->explicit_parent
= 1;
4070 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4071 f
->output_data
.x
->explicit_parent
= 0;
4074 /* Set the name; the functions to which we pass f expect the name to
4076 if (EQ (name
, Qunbound
) || NILP (name
))
4078 f
->name
= build_string (dpyinfo
->x_id_name
);
4079 f
->explicit_name
= 0;
4084 f
->explicit_name
= 1;
4085 /* use the frame's title when getting resources for this frame. */
4086 specbind (Qx_resource_name
, name
);
4089 /* Extract the window parameters from the supplied values
4090 that are needed to determine window geometry. */
4094 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4097 /* First, try whatever font the caller has specified. */
4100 tem
= Fquery_fontset (font
, Qnil
);
4102 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4104 font
= x_new_font (f
, XSTRING (font
)->data
);
4107 /* Try out a font which we hope has bold and italic variations. */
4108 if (!STRINGP (font
))
4109 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4110 if (!STRINGP (font
))
4111 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4112 if (! STRINGP (font
))
4113 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4114 if (! STRINGP (font
))
4115 /* This was formerly the first thing tried, but it finds too many fonts
4116 and takes too long. */
4117 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4118 /* If those didn't work, look for something which will at least work. */
4119 if (! STRINGP (font
))
4120 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4122 if (! STRINGP (font
))
4123 font
= build_string ("fixed");
4125 x_default_parameter (f
, parms
, Qfont
, font
,
4126 "font", "Font", RES_TYPE_STRING
);
4130 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4131 whereby it fails to get any font. */
4132 xlwmenu_default_font
= f
->output_data
.x
->font
;
4135 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4136 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4138 /* This defaults to 2 in order to match xterm. We recognize either
4139 internalBorderWidth or internalBorder (which is what xterm calls
4141 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4145 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4146 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4147 if (! EQ (value
, Qunbound
))
4148 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4151 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4152 "internalBorderWidth", "internalBorderWidth",
4154 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4155 "verticalScrollBars", "ScrollBars",
4158 /* Also do the stuff which must be set before the window exists. */
4159 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4160 "foreground", "Foreground", RES_TYPE_STRING
);
4161 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4162 "background", "Background", RES_TYPE_STRING
);
4163 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4164 "pointerColor", "Foreground", RES_TYPE_STRING
);
4165 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4166 "cursorColor", "Foreground", RES_TYPE_STRING
);
4167 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4168 "borderColor", "BorderColor", RES_TYPE_STRING
);
4169 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4170 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4171 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4172 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4174 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4175 "scrollBarForeground",
4176 "ScrollBarForeground", 1);
4177 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4178 "scrollBarBackground",
4179 "ScrollBarBackground", 0);
4181 /* Init faces before x_default_parameter is called for scroll-bar
4182 parameters because that function calls x_set_scroll_bar_width,
4183 which calls change_frame_size, which calls Fset_window_buffer,
4184 which runs hooks, which call Fvertical_motion. At the end, we
4185 end up in init_iterator with a null face cache, which should not
4187 init_frame_faces (f
);
4189 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4190 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4191 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4192 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4193 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4194 "bufferPredicate", "BufferPredicate",
4196 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4197 "title", "Title", RES_TYPE_STRING
);
4199 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4200 window_prompting
= x_figure_window_size (f
, parms
);
4202 if (window_prompting
& XNegative
)
4204 if (window_prompting
& YNegative
)
4205 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4207 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4211 if (window_prompting
& YNegative
)
4212 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4214 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4217 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4219 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4220 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4222 /* Create the X widget or window. Add the tool-bar height to the
4223 initial frame height so that the user gets a text display area of
4224 the size he specified with -g or via .Xdefaults. Later changes
4225 of the tool-bar height don't change the frame size. This is done
4226 so that users can create tall Emacs frames without having to
4227 guess how tall the tool-bar will get. */
4228 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4230 #ifdef USE_X_TOOLKIT
4231 x_window (f
, window_prompting
, minibuffer_only
);
4239 /* Now consider the frame official. */
4240 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4241 Vframe_list
= Fcons (frame
, Vframe_list
);
4243 /* We need to do this after creating the X window, so that the
4244 icon-creation functions can say whose icon they're describing. */
4245 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4246 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4248 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4249 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4250 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4251 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4252 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4253 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4254 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4255 "scrollBarWidth", "ScrollBarWidth",
4258 /* Dimensions, especially f->height, must be done via change_frame_size.
4259 Change will not be effected unless different from the current
4264 SET_FRAME_WIDTH (f
, 0);
4265 change_frame_size (f
, height
, width
, 1, 0, 0);
4267 /* Set up faces after all frame parameters are known. */
4268 call1 (Qface_set_after_frame_default
, frame
);
4270 #ifdef USE_X_TOOLKIT
4271 /* Create the menu bar. */
4272 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4274 /* If this signals an error, we haven't set size hints for the
4275 frame and we didn't make it visible. */
4276 initialize_frame_menubar (f
);
4278 /* This is a no-op, except under Motif where it arranges the
4279 main window for the widgets on it. */
4280 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4281 f
->output_data
.x
->menubar_widget
,
4282 f
->output_data
.x
->edit_widget
);
4284 #endif /* USE_X_TOOLKIT */
4286 /* Tell the server what size and position, etc, we want, and how
4287 badly we want them. This should be done after we have the menu
4288 bar so that its size can be taken into account. */
4290 x_wm_set_size_hint (f
, window_prompting
, 0);
4293 /* Make the window appear on the frame and enable display, unless
4294 the caller says not to. However, with explicit parent, Emacs
4295 cannot control visibility, so don't try. */
4296 if (! f
->output_data
.x
->explicit_parent
)
4298 Lisp_Object visibility
;
4300 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4302 if (EQ (visibility
, Qunbound
))
4305 if (EQ (visibility
, Qicon
))
4306 x_iconify_frame (f
);
4307 else if (! NILP (visibility
))
4308 x_make_frame_visible (f
);
4310 /* Must have been Qnil. */
4315 return unbind_to (count
, frame
);
4318 /* FRAME is used only to get a handle on the X display. We don't pass the
4319 display info directly because we're called from frame.c, which doesn't
4320 know about that structure. */
4323 x_get_focus_frame (frame
)
4324 struct frame
*frame
;
4326 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4328 if (! dpyinfo
->x_focus_frame
)
4331 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4336 /* In certain situations, when the window manager follows a
4337 click-to-focus policy, there seems to be no way around calling
4338 XSetInputFocus to give another frame the input focus .
4340 In an ideal world, XSetInputFocus should generally be avoided so
4341 that applications don't interfere with the window manager's focus
4342 policy. But I think it's okay to use when it's clearly done
4343 following a user-command. */
4345 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4346 "Set the input focus to FRAME.\n\
4347 FRAME nil means use the selected frame.")
4351 struct frame
*f
= check_x_frame (frame
);
4352 Display
*dpy
= FRAME_X_DISPLAY (f
);
4356 count
= x_catch_errors (dpy
);
4357 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4358 RevertToParent
, CurrentTime
);
4359 x_uncatch_errors (dpy
, count
);
4366 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4367 "Internal function called by `color-defined-p', 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))
4382 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4383 "Internal function called by `color-values', which see.")
4385 Lisp_Object color
, frame
;
4388 FRAME_PTR f
= check_x_frame (frame
);
4390 CHECK_STRING (color
, 1);
4392 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4396 rgb
[0] = make_number (foo
.red
);
4397 rgb
[1] = make_number (foo
.green
);
4398 rgb
[2] = make_number (foo
.blue
);
4399 return Flist (3, rgb
);
4405 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4406 "Internal function called by `display-color-p', which see.")
4408 Lisp_Object display
;
4410 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4412 if (dpyinfo
->n_planes
<= 2)
4415 switch (dpyinfo
->visual
->class)
4428 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4430 "Return t if the X display supports shades of gray.\n\
4431 Note that color displays do support shades of gray.\n\
4432 The optional argument DISPLAY specifies which display to ask about.\n\
4433 DISPLAY should be either a frame or a display name (a string).\n\
4434 If omitted or nil, that stands for the selected frame's display.")
4436 Lisp_Object display
;
4438 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4440 if (dpyinfo
->n_planes
<= 1)
4443 switch (dpyinfo
->visual
->class)
4458 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4460 "Returns the width in pixels of the X display DISPLAY.\n\
4461 The optional argument DISPLAY specifies which display to ask about.\n\
4462 DISPLAY should be either a frame or a display name (a string).\n\
4463 If omitted or nil, that stands for the selected frame's display.")
4465 Lisp_Object display
;
4467 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4469 return make_number (dpyinfo
->width
);
4472 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4473 Sx_display_pixel_height
, 0, 1, 0,
4474 "Returns the height in pixels of the X display DISPLAY.\n\
4475 The optional argument DISPLAY specifies which display to ask about.\n\
4476 DISPLAY should be either a frame or a display name (a string).\n\
4477 If omitted or nil, that stands for the selected frame's display.")
4479 Lisp_Object display
;
4481 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4483 return make_number (dpyinfo
->height
);
4486 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4488 "Returns the number of bitplanes of the X display DISPLAY.\n\
4489 The optional argument DISPLAY specifies which display to ask about.\n\
4490 DISPLAY should be either a frame or a display name (a string).\n\
4491 If omitted or nil, that stands for the selected frame's display.")
4493 Lisp_Object display
;
4495 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4497 return make_number (dpyinfo
->n_planes
);
4500 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4502 "Returns the number of color cells of the X 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 (DisplayCells (dpyinfo
->display
,
4512 XScreenNumberOfScreen (dpyinfo
->screen
)));
4515 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4516 Sx_server_max_request_size
,
4518 "Returns the maximum request size of the X server of display DISPLAY.\n\
4519 The optional argument DISPLAY specifies which display to ask about.\n\
4520 DISPLAY should be either a frame or a display name (a string).\n\
4521 If omitted or nil, that stands for the selected frame's display.")
4523 Lisp_Object display
;
4525 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4527 return make_number (MAXREQUEST (dpyinfo
->display
));
4530 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4531 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4532 The optional argument DISPLAY specifies which display to ask about.\n\
4533 DISPLAY should be either a frame or a display name (a string).\n\
4534 If omitted or nil, that stands for the selected frame's display.")
4536 Lisp_Object display
;
4538 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4539 char *vendor
= ServerVendor (dpyinfo
->display
);
4541 if (! vendor
) vendor
= "";
4542 return build_string (vendor
);
4545 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4546 "Returns the version numbers of the X server of display DISPLAY.\n\
4547 The value is a list of three integers: the major and minor\n\
4548 version numbers of the X Protocol in use, and the vendor-specific release\n\
4549 number. See also the function `x-server-vendor'.\n\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
);
4557 Display
*dpy
= dpyinfo
->display
;
4559 return Fcons (make_number (ProtocolVersion (dpy
)),
4560 Fcons (make_number (ProtocolRevision (dpy
)),
4561 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4564 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4565 "Returns the number of screens on the X server of display DISPLAY.\n\
4566 The optional argument DISPLAY specifies which display to ask about.\n\
4567 DISPLAY should be either a frame or a display name (a string).\n\
4568 If omitted or nil, that stands for the selected frame's display.")
4570 Lisp_Object display
;
4572 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4574 return make_number (ScreenCount (dpyinfo
->display
));
4577 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4578 "Returns the height in millimeters of the X display DISPLAY.\n\
4579 The optional argument DISPLAY specifies which display to ask about.\n\
4580 DISPLAY should be either a frame or a display name (a string).\n\
4581 If omitted or nil, that stands for the selected frame's display.")
4583 Lisp_Object display
;
4585 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4587 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4590 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4591 "Returns the width in millimeters of the X display DISPLAY.\n\
4592 The optional argument DISPLAY specifies which display to ask about.\n\
4593 DISPLAY should be either a frame or a display name (a string).\n\
4594 If omitted or nil, that stands for the selected frame's display.")
4596 Lisp_Object display
;
4598 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4600 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4603 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4604 Sx_display_backing_store
, 0, 1, 0,
4605 "Returns an indication of whether X display DISPLAY does backing store.\n\
4606 The value may be `always', `when-mapped', or `not-useful'.\n\
4607 The optional argument DISPLAY specifies which display to ask about.\n\
4608 DISPLAY should be either a frame or a display name (a string).\n\
4609 If omitted or nil, that stands for the selected frame's display.")
4611 Lisp_Object display
;
4613 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4616 switch (DoesBackingStore (dpyinfo
->screen
))
4619 result
= intern ("always");
4623 result
= intern ("when-mapped");
4627 result
= intern ("not-useful");
4631 error ("Strange value for BackingStore parameter of screen");
4638 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4639 Sx_display_visual_class
, 0, 1, 0,
4640 "Returns the visual class of the X display DISPLAY.\n\
4641 The value is one of the symbols `static-gray', `gray-scale',\n\
4642 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4643 The optional argument DISPLAY specifies which display to ask about.\n\
4644 DISPLAY should be either a frame or a display name (a string).\n\
4645 If omitted or nil, that stands for the selected frame's display.")
4647 Lisp_Object display
;
4649 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4652 switch (dpyinfo
->visual
->class)
4655 result
= intern ("static-gray");
4658 result
= intern ("gray-scale");
4661 result
= intern ("static-color");
4664 result
= intern ("pseudo-color");
4667 result
= intern ("true-color");
4670 result
= intern ("direct-color");
4673 error ("Display has an unknown visual class");
4680 DEFUN ("x-display-save-under", Fx_display_save_under
,
4681 Sx_display_save_under
, 0, 1, 0,
4682 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4683 The optional argument DISPLAY specifies which display to ask about.\n\
4684 DISPLAY should be either a frame or a display name (a string).\n\
4685 If omitted or nil, that stands for the selected frame's display.")
4687 Lisp_Object display
;
4689 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4691 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4699 register struct frame
*f
;
4701 return PIXEL_WIDTH (f
);
4706 register struct frame
*f
;
4708 return PIXEL_HEIGHT (f
);
4713 register struct frame
*f
;
4715 return FONT_WIDTH (f
->output_data
.x
->font
);
4720 register struct frame
*f
;
4722 return f
->output_data
.x
->line_height
;
4727 register struct frame
*f
;
4729 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4734 /************************************************************************
4736 ************************************************************************/
4739 /* Mapping visual names to visuals. */
4741 static struct visual_class
4748 {"StaticGray", StaticGray
},
4749 {"GrayScale", GrayScale
},
4750 {"StaticColor", StaticColor
},
4751 {"PseudoColor", PseudoColor
},
4752 {"TrueColor", TrueColor
},
4753 {"DirectColor", DirectColor
},
4758 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4760 /* Value is the screen number of screen SCR. This is a substitute for
4761 the X function with the same name when that doesn't exist. */
4764 XScreenNumberOfScreen (scr
)
4765 register Screen
*scr
;
4767 Display
*dpy
= scr
->display
;
4770 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4771 if (scr
== dpy
->screens
[i
])
4777 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4780 /* Select the visual that should be used on display DPYINFO. Set
4781 members of DPYINFO appropriately. Called from x_term_init. */
4784 select_visual (dpyinfo
)
4785 struct x_display_info
*dpyinfo
;
4787 Display
*dpy
= dpyinfo
->display
;
4788 Screen
*screen
= dpyinfo
->screen
;
4791 /* See if a visual is specified. */
4792 value
= display_x_get_resource (dpyinfo
,
4793 build_string ("visualClass"),
4794 build_string ("VisualClass"),
4796 if (STRINGP (value
))
4798 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4799 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4800 depth, a decimal number. NAME is compared with case ignored. */
4801 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4806 strcpy (s
, XSTRING (value
)->data
);
4807 dash
= index (s
, '-');
4810 dpyinfo
->n_planes
= atoi (dash
+ 1);
4814 /* We won't find a matching visual with depth 0, so that
4815 an error will be printed below. */
4816 dpyinfo
->n_planes
= 0;
4818 /* Determine the visual class. */
4819 for (i
= 0; visual_classes
[i
].name
; ++i
)
4820 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4822 class = visual_classes
[i
].class;
4826 /* Look up a matching visual for the specified class. */
4828 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4829 dpyinfo
->n_planes
, class, &vinfo
))
4830 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4832 dpyinfo
->visual
= vinfo
.visual
;
4837 XVisualInfo
*vinfo
, vinfo_template
;
4839 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4842 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4844 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4846 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4847 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4848 &vinfo_template
, &n_visuals
);
4850 fatal ("Can't get proper X visual info");
4852 dpyinfo
->n_planes
= vinfo
->depth
;
4853 XFree ((char *) vinfo
);
4858 /* Return the X display structure for the display named NAME.
4859 Open a new connection if necessary. */
4861 struct x_display_info
*
4862 x_display_info_for_name (name
)
4866 struct x_display_info
*dpyinfo
;
4868 CHECK_STRING (name
, 0);
4870 if (! EQ (Vwindow_system
, intern ("x")))
4871 error ("Not using X Windows");
4873 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4875 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4878 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4883 /* Use this general default value to start with. */
4884 Vx_resource_name
= Vinvocation_name
;
4886 validate_x_resource_name ();
4888 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4889 (char *) XSTRING (Vx_resource_name
)->data
);
4892 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4895 XSETFASTINT (Vwindow_system_version
, 11);
4901 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4902 1, 3, 0, "Open a connection to an X server.\n\
4903 DISPLAY is the name of the display to connect to.\n\
4904 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4905 If the optional third arg MUST-SUCCEED is non-nil,\n\
4906 terminate Emacs if we can't open the connection.")
4907 (display
, xrm_string
, must_succeed
)
4908 Lisp_Object display
, xrm_string
, must_succeed
;
4910 unsigned char *xrm_option
;
4911 struct x_display_info
*dpyinfo
;
4913 CHECK_STRING (display
, 0);
4914 if (! NILP (xrm_string
))
4915 CHECK_STRING (xrm_string
, 1);
4917 if (! EQ (Vwindow_system
, intern ("x")))
4918 error ("Not using X Windows");
4920 if (! NILP (xrm_string
))
4921 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4923 xrm_option
= (unsigned char *) 0;
4925 validate_x_resource_name ();
4927 /* This is what opens the connection and sets x_current_display.
4928 This also initializes many symbols, such as those used for input. */
4929 dpyinfo
= x_term_init (display
, xrm_option
,
4930 (char *) XSTRING (Vx_resource_name
)->data
);
4934 if (!NILP (must_succeed
))
4935 fatal ("Cannot connect to X server %s.\n\
4936 Check the DISPLAY environment variable or use `-d'.\n\
4937 Also use the `xhost' program to verify that it is set to permit\n\
4938 connections from your machine.\n",
4939 XSTRING (display
)->data
);
4941 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4946 XSETFASTINT (Vwindow_system_version
, 11);
4950 DEFUN ("x-close-connection", Fx_close_connection
,
4951 Sx_close_connection
, 1, 1, 0,
4952 "Close the connection to DISPLAY's X server.\n\
4953 For DISPLAY, specify either a frame or a display name (a string).\n\
4954 If DISPLAY is nil, that stands for the selected frame's display.")
4956 Lisp_Object display
;
4958 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4961 if (dpyinfo
->reference_count
> 0)
4962 error ("Display still has frames on it");
4965 /* Free the fonts in the font table. */
4966 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4967 if (dpyinfo
->font_table
[i
].name
)
4969 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4970 xfree (dpyinfo
->font_table
[i
].full_name
);
4971 xfree (dpyinfo
->font_table
[i
].name
);
4972 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4975 x_destroy_all_bitmaps (dpyinfo
);
4976 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4978 #ifdef USE_X_TOOLKIT
4979 XtCloseDisplay (dpyinfo
->display
);
4981 XCloseDisplay (dpyinfo
->display
);
4984 x_delete_display (dpyinfo
);
4990 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4991 "Return the list of display names that Emacs has connections to.")
4994 Lisp_Object tail
, result
;
4997 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4998 result
= Fcons (XCAR (XCAR (tail
)), result
);
5003 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5004 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5005 If ON is nil, allow buffering of requests.\n\
5006 Turning on synchronization prohibits the Xlib routines from buffering\n\
5007 requests and seriously degrades performance, but makes debugging much\n\
5009 The optional second argument DISPLAY specifies which display to act on.\n\
5010 DISPLAY should be either a frame or a display name (a string).\n\
5011 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5013 Lisp_Object display
, on
;
5015 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5017 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5022 /* Wait for responses to all X commands issued so far for frame F. */
5029 XSync (FRAME_X_DISPLAY (f
), False
);
5034 /***********************************************************************
5036 ***********************************************************************/
5038 /* Value is the number of elements of vector VECTOR. */
5040 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5042 /* List of supported image types. Use define_image_type to add new
5043 types. Use lookup_image_type to find a type for a given symbol. */
5045 static struct image_type
*image_types
;
5047 /* The symbol `image' which is the car of the lists used to represent
5050 extern Lisp_Object Qimage
;
5052 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5058 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5059 extern Lisp_Object QCdata
;
5060 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5061 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5062 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5064 /* Other symbols. */
5066 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5068 /* Time in seconds after which images should be removed from the cache
5069 if not displayed. */
5071 Lisp_Object Vimage_cache_eviction_delay
;
5073 /* Function prototypes. */
5075 static void define_image_type
P_ ((struct image_type
*type
));
5076 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5077 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5078 static void x_laplace
P_ ((struct frame
*, struct image
*));
5079 static void x_emboss
P_ ((struct frame
*, struct image
*));
5080 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5084 /* Define a new image type from TYPE. This adds a copy of TYPE to
5085 image_types and adds the symbol *TYPE->type to Vimage_types. */
5088 define_image_type (type
)
5089 struct image_type
*type
;
5091 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5092 The initialized data segment is read-only. */
5093 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5094 bcopy (type
, p
, sizeof *p
);
5095 p
->next
= image_types
;
5097 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5101 /* Look up image type SYMBOL, and return a pointer to its image_type
5102 structure. Value is null if SYMBOL is not a known image type. */
5104 static INLINE
struct image_type
*
5105 lookup_image_type (symbol
)
5108 struct image_type
*type
;
5110 for (type
= image_types
; type
; type
= type
->next
)
5111 if (EQ (symbol
, *type
->type
))
5118 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5119 valid image specification is a list whose car is the symbol
5120 `image', and whose rest is a property list. The property list must
5121 contain a value for key `:type'. That value must be the name of a
5122 supported image type. The rest of the property list depends on the
5126 valid_image_p (object
)
5131 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5133 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5134 struct image_type
*type
= lookup_image_type (symbol
);
5137 valid_p
= type
->valid_p (object
);
5144 /* Log error message with format string FORMAT and argument ARG.
5145 Signaling an error, e.g. when an image cannot be loaded, is not a
5146 good idea because this would interrupt redisplay, and the error
5147 message display would lead to another redisplay. This function
5148 therefore simply displays a message. */
5151 image_error (format
, arg1
, arg2
)
5153 Lisp_Object arg1
, arg2
;
5155 add_to_log (format
, arg1
, arg2
);
5160 /***********************************************************************
5161 Image specifications
5162 ***********************************************************************/
5164 enum image_value_type
5166 IMAGE_DONT_CHECK_VALUE_TYPE
,
5169 IMAGE_POSITIVE_INTEGER_VALUE
,
5170 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5172 IMAGE_INTEGER_VALUE
,
5173 IMAGE_FUNCTION_VALUE
,
5178 /* Structure used when parsing image specifications. */
5180 struct image_keyword
5182 /* Name of keyword. */
5185 /* The type of value allowed. */
5186 enum image_value_type type
;
5188 /* Non-zero means key must be present. */
5191 /* Used to recognize duplicate keywords in a property list. */
5194 /* The value that was found. */
5199 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5201 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5204 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5205 has the format (image KEYWORD VALUE ...). One of the keyword/
5206 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5207 image_keywords structures of size NKEYWORDS describing other
5208 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5211 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5213 struct image_keyword
*keywords
;
5220 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5223 plist
= XCDR (spec
);
5224 while (CONSP (plist
))
5226 Lisp_Object key
, value
;
5228 /* First element of a pair must be a symbol. */
5230 plist
= XCDR (plist
);
5234 /* There must follow a value. */
5237 value
= XCAR (plist
);
5238 plist
= XCDR (plist
);
5240 /* Find key in KEYWORDS. Error if not found. */
5241 for (i
= 0; i
< nkeywords
; ++i
)
5242 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5248 /* Record that we recognized the keyword. If a keywords
5249 was found more than once, it's an error. */
5250 keywords
[i
].value
= value
;
5251 ++keywords
[i
].count
;
5253 if (keywords
[i
].count
> 1)
5256 /* Check type of value against allowed type. */
5257 switch (keywords
[i
].type
)
5259 case IMAGE_STRING_VALUE
:
5260 if (!STRINGP (value
))
5264 case IMAGE_SYMBOL_VALUE
:
5265 if (!SYMBOLP (value
))
5269 case IMAGE_POSITIVE_INTEGER_VALUE
:
5270 if (!INTEGERP (value
) || XINT (value
) <= 0)
5274 case IMAGE_ASCENT_VALUE
:
5275 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5277 else if (INTEGERP (value
)
5278 && XINT (value
) >= 0
5279 && XINT (value
) <= 100)
5283 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5284 if (!INTEGERP (value
) || XINT (value
) < 0)
5288 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5291 case IMAGE_FUNCTION_VALUE
:
5292 value
= indirect_function (value
);
5294 || COMPILEDP (value
)
5295 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5299 case IMAGE_NUMBER_VALUE
:
5300 if (!INTEGERP (value
) && !FLOATP (value
))
5304 case IMAGE_INTEGER_VALUE
:
5305 if (!INTEGERP (value
))
5309 case IMAGE_BOOL_VALUE
:
5310 if (!NILP (value
) && !EQ (value
, Qt
))
5319 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5323 /* Check that all mandatory fields are present. */
5324 for (i
= 0; i
< nkeywords
; ++i
)
5325 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5328 return NILP (plist
);
5332 /* Return the value of KEY in image specification SPEC. Value is nil
5333 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5334 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5337 image_spec_value (spec
, key
, found
)
5338 Lisp_Object spec
, key
;
5343 xassert (valid_image_p (spec
));
5345 for (tail
= XCDR (spec
);
5346 CONSP (tail
) && CONSP (XCDR (tail
));
5347 tail
= XCDR (XCDR (tail
)))
5349 if (EQ (XCAR (tail
), key
))
5353 return XCAR (XCDR (tail
));
5363 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5364 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5365 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5366 size in canonical character units.\n\
5367 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5368 or omitted means use the selected frame.")
5369 (spec
, pixels
, frame
)
5370 Lisp_Object spec
, pixels
, frame
;
5375 if (valid_image_p (spec
))
5377 struct frame
*f
= check_x_frame (frame
);
5378 int id
= lookup_image (f
, spec
);
5379 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5380 int width
= img
->width
+ 2 * img
->margin
;
5381 int height
= img
->height
+ 2 * img
->margin
;
5384 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5385 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5387 size
= Fcons (make_number (width
), make_number (height
));
5390 error ("Invalid image specification");
5396 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5397 "Return t if image SPEC has a mask bitmap.\n\
5398 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5399 or omitted means use the selected frame.")
5401 Lisp_Object spec
, frame
;
5406 if (valid_image_p (spec
))
5408 struct frame
*f
= check_x_frame (frame
);
5409 int id
= lookup_image (f
, spec
);
5410 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5415 error ("Invalid image specification");
5422 /***********************************************************************
5423 Image type independent image structures
5424 ***********************************************************************/
5426 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5427 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5430 /* Allocate and return a new image structure for image specification
5431 SPEC. SPEC has a hash value of HASH. */
5433 static struct image
*
5434 make_image (spec
, hash
)
5438 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5440 xassert (valid_image_p (spec
));
5441 bzero (img
, sizeof *img
);
5442 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5443 xassert (img
->type
!= NULL
);
5445 img
->data
.lisp_val
= Qnil
;
5446 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5452 /* Free image IMG which was used on frame F, including its resources. */
5461 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5463 /* Remove IMG from the hash table of its cache. */
5465 img
->prev
->next
= img
->next
;
5467 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5470 img
->next
->prev
= img
->prev
;
5472 c
->images
[img
->id
] = NULL
;
5474 /* Free resources, then free IMG. */
5475 img
->type
->free (f
, img
);
5481 /* Prepare image IMG for display on frame F. Must be called before
5482 drawing an image. */
5485 prepare_image_for_display (f
, img
)
5491 /* We're about to display IMG, so set its timestamp to `now'. */
5493 img
->timestamp
= EMACS_SECS (t
);
5495 /* If IMG doesn't have a pixmap yet, load it now, using the image
5496 type dependent loader function. */
5497 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5498 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5502 /* Value is the number of pixels for the ascent of image IMG when
5503 drawn in face FACE. */
5506 image_ascent (img
, face
)
5510 int height
= img
->height
+ img
->margin
;
5513 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5516 ascent
= height
/ 2 - (face
->font
->descent
- face
->font
->ascent
) / 2;
5518 ascent
= height
/ 2;
5521 ascent
= height
* img
->ascent
/ 100.0;
5528 /***********************************************************************
5529 Helper functions for X image types
5530 ***********************************************************************/
5532 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5534 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5535 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5537 Lisp_Object color_name
,
5538 unsigned long dflt
));
5541 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5542 free the pixmap if any. MASK_P non-zero means clear the mask
5543 pixmap if any. COLORS_P non-zero means free colors allocated for
5544 the image, if any. */
5547 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5550 int pixmap_p
, mask_p
, colors_p
;
5552 if (pixmap_p
&& img
->pixmap
)
5554 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5558 if (mask_p
&& img
->mask
)
5560 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5564 if (colors_p
&& img
->ncolors
)
5566 x_free_colors (f
, img
->colors
, img
->ncolors
);
5567 xfree (img
->colors
);
5573 /* Free X resources of image IMG which is used on frame F. */
5576 x_clear_image (f
, img
)
5581 x_clear_image_1 (f
, img
, 1, 1, 1);
5586 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5587 cannot be allocated, use DFLT. Add a newly allocated color to
5588 IMG->colors, so that it can be freed again. Value is the pixel
5591 static unsigned long
5592 x_alloc_image_color (f
, img
, color_name
, dflt
)
5595 Lisp_Object color_name
;
5599 unsigned long result
;
5601 xassert (STRINGP (color_name
));
5603 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5605 /* This isn't called frequently so we get away with simply
5606 reallocating the color vector to the needed size, here. */
5609 (unsigned long *) xrealloc (img
->colors
,
5610 img
->ncolors
* sizeof *img
->colors
);
5611 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5612 result
= color
.pixel
;
5622 /***********************************************************************
5624 ***********************************************************************/
5626 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5629 /* Return a new, initialized image cache that is allocated from the
5630 heap. Call free_image_cache to free an image cache. */
5632 struct image_cache
*
5635 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5638 bzero (c
, sizeof *c
);
5640 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5641 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5642 c
->buckets
= (struct image
**) xmalloc (size
);
5643 bzero (c
->buckets
, size
);
5648 /* Free image cache of frame F. Be aware that X frames share images
5652 free_image_cache (f
)
5655 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5660 /* Cache should not be referenced by any frame when freed. */
5661 xassert (c
->refcount
== 0);
5663 for (i
= 0; i
< c
->used
; ++i
)
5664 free_image (f
, c
->images
[i
]);
5668 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5673 /* Clear image cache of frame F. FORCE_P non-zero means free all
5674 images. FORCE_P zero means clear only images that haven't been
5675 displayed for some time. Should be called from time to time to
5676 reduce the number of loaded images. If image-eviction-seconds is
5677 non-nil, this frees images in the cache which weren't displayed for
5678 at least that many seconds. */
5681 clear_image_cache (f
, force_p
)
5685 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5687 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5694 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5696 /* Block input so that we won't be interrupted by a SIGIO
5697 while being in an inconsistent state. */
5700 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5702 struct image
*img
= c
->images
[i
];
5704 && (force_p
|| img
->timestamp
< old
))
5706 free_image (f
, img
);
5711 /* We may be clearing the image cache because, for example,
5712 Emacs was iconified for a longer period of time. In that
5713 case, current matrices may still contain references to
5714 images freed above. So, clear these matrices. */
5717 Lisp_Object tail
, frame
;
5719 FOR_EACH_FRAME (tail
, frame
)
5721 struct frame
*f
= XFRAME (frame
);
5723 && FRAME_X_IMAGE_CACHE (f
) == c
)
5724 clear_current_matrices (f
);
5727 ++windows_or_buffers_changed
;
5735 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5737 "Clear the image cache of FRAME.\n\
5738 FRAME nil or omitted means use the selected frame.\n\
5739 FRAME t means clear the image caches of all frames.")
5747 FOR_EACH_FRAME (tail
, frame
)
5748 if (FRAME_X_P (XFRAME (frame
)))
5749 clear_image_cache (XFRAME (frame
), 1);
5752 clear_image_cache (check_x_frame (frame
), 1);
5758 /* Return the id of image with Lisp specification SPEC on frame F.
5759 SPEC must be a valid Lisp image specification (see valid_image_p). */
5762 lookup_image (f
, spec
)
5766 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5770 struct gcpro gcpro1
;
5773 /* F must be a window-system frame, and SPEC must be a valid image
5775 xassert (FRAME_WINDOW_P (f
));
5776 xassert (valid_image_p (spec
));
5780 /* Look up SPEC in the hash table of the image cache. */
5781 hash
= sxhash (spec
, 0);
5782 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5784 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5785 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5788 /* If not found, create a new image and cache it. */
5792 img
= make_image (spec
, hash
);
5793 cache_image (f
, img
);
5794 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5796 /* If we can't load the image, and we don't have a width and
5797 height, use some arbitrary width and height so that we can
5798 draw a rectangle for it. */
5799 if (img
->load_failed_p
)
5803 value
= image_spec_value (spec
, QCwidth
, NULL
);
5804 img
->width
= (INTEGERP (value
)
5805 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5806 value
= image_spec_value (spec
, QCheight
, NULL
);
5807 img
->height
= (INTEGERP (value
)
5808 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5812 /* Handle image type independent image attributes
5813 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5814 Lisp_Object ascent
, margin
, relief
;
5817 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5818 if (INTEGERP (ascent
))
5819 img
->ascent
= XFASTINT (ascent
);
5820 else if (EQ (ascent
, Qcenter
))
5821 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5823 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5824 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5825 img
->margin
= XFASTINT (margin
);
5827 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5828 if (INTEGERP (relief
))
5830 img
->relief
= XINT (relief
);
5831 img
->margin
+= abs (img
->relief
);
5834 /* Manipulation of the image's mask. */
5837 /* `:heuristic-mask t'
5839 means build a mask heuristically.
5840 `:heuristic-mask (R G B)'
5841 `:mask (heuristic (R G B))'
5842 means build a mask from color (R G B) in the
5845 means remove a mask, if any. */
5849 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5851 x_build_heuristic_mask (f
, img
, mask
);
5856 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5858 if (EQ (mask
, Qheuristic
))
5859 x_build_heuristic_mask (f
, img
, Qt
);
5860 else if (CONSP (mask
)
5861 && EQ (XCAR (mask
), Qheuristic
))
5863 if (CONSP (XCDR (mask
)))
5864 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5866 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5868 else if (NILP (mask
) && found_p
&& img
->mask
)
5870 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5876 /* Should we apply an image transformation algorithm? */
5879 Lisp_Object algorithm
;
5881 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5882 if (EQ (algorithm
, Qdisabled
))
5883 x_disable_image (f
, img
);
5884 else if (EQ (algorithm
, Qlaplace
))
5886 else if (EQ (algorithm
, Qemboss
))
5888 else if (CONSP (algorithm
)
5889 && EQ (XCAR (algorithm
), Qedge_detection
))
5892 tem
= XCDR (algorithm
);
5894 x_edge_detection (f
, img
,
5895 Fplist_get (tem
, QCmatrix
),
5896 Fplist_get (tem
, QCcolor_adjustment
));
5902 xassert (!interrupt_input_blocked
);
5905 /* We're using IMG, so set its timestamp to `now'. */
5906 EMACS_GET_TIME (now
);
5907 img
->timestamp
= EMACS_SECS (now
);
5911 /* Value is the image id. */
5916 /* Cache image IMG in the image cache of frame F. */
5919 cache_image (f
, img
)
5923 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5926 /* Find a free slot in c->images. */
5927 for (i
= 0; i
< c
->used
; ++i
)
5928 if (c
->images
[i
] == NULL
)
5931 /* If no free slot found, maybe enlarge c->images. */
5932 if (i
== c
->used
&& c
->used
== c
->size
)
5935 c
->images
= (struct image
**) xrealloc (c
->images
,
5936 c
->size
* sizeof *c
->images
);
5939 /* Add IMG to c->images, and assign IMG an id. */
5945 /* Add IMG to the cache's hash table. */
5946 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5947 img
->next
= c
->buckets
[i
];
5949 img
->next
->prev
= img
;
5951 c
->buckets
[i
] = img
;
5955 /* Call FN on every image in the image cache of frame F. Used to mark
5956 Lisp Objects in the image cache. */
5959 forall_images_in_image_cache (f
, fn
)
5961 void (*fn
) P_ ((struct image
*img
));
5963 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5965 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5969 for (i
= 0; i
< c
->used
; ++i
)
5978 /***********************************************************************
5980 ***********************************************************************/
5982 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5983 XImage
**, Pixmap
*));
5984 static void x_destroy_x_image
P_ ((XImage
*));
5985 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5988 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5989 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5990 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5991 via xmalloc. Print error messages via image_error if an error
5992 occurs. Value is non-zero if successful. */
5995 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5997 int width
, height
, depth
;
6001 Display
*display
= FRAME_X_DISPLAY (f
);
6002 Screen
*screen
= FRAME_X_SCREEN (f
);
6003 Window window
= FRAME_X_WINDOW (f
);
6005 xassert (interrupt_input_blocked
);
6008 depth
= DefaultDepthOfScreen (screen
);
6009 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6010 depth
, ZPixmap
, 0, NULL
, width
, height
,
6011 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6014 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6018 /* Allocate image raster. */
6019 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6021 /* Allocate a pixmap of the same size. */
6022 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6023 if (*pixmap
== None
)
6025 x_destroy_x_image (*ximg
);
6027 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6035 /* Destroy XImage XIMG. Free XIMG->data. */
6038 x_destroy_x_image (ximg
)
6041 xassert (interrupt_input_blocked
);
6046 XDestroyImage (ximg
);
6051 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6052 are width and height of both the image and pixmap. */
6055 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6062 xassert (interrupt_input_blocked
);
6063 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6064 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6065 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6070 /***********************************************************************
6072 ***********************************************************************/
6074 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6075 static char *slurp_file
P_ ((char *, int *));
6078 /* Find image file FILE. Look in data-directory, then
6079 x-bitmap-file-path. Value is the full name of the file found, or
6080 nil if not found. */
6083 x_find_image_file (file
)
6086 Lisp_Object file_found
, search_path
;
6087 struct gcpro gcpro1
, gcpro2
;
6091 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6092 GCPRO2 (file_found
, search_path
);
6094 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6095 fd
= openp (search_path
, file
, "", &file_found
, 0);
6107 /* Read FILE into memory. Value is a pointer to a buffer allocated
6108 with xmalloc holding FILE's contents. Value is null if an error
6109 occurred. *SIZE is set to the size of the file. */
6112 slurp_file (file
, size
)
6120 if (stat (file
, &st
) == 0
6121 && (fp
= fopen (file
, "r")) != NULL
6122 && (buf
= (char *) xmalloc (st
.st_size
),
6123 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6144 /***********************************************************************
6146 ***********************************************************************/
6148 static int xbm_scan
P_ ((char **, char *, char *, int *));
6149 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6150 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6152 static int xbm_image_p
P_ ((Lisp_Object object
));
6153 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6155 static int xbm_file_p
P_ ((Lisp_Object
));
6158 /* Indices of image specification fields in xbm_format, below. */
6160 enum xbm_keyword_index
6178 /* Vector of image_keyword structures describing the format
6179 of valid XBM image specifications. */
6181 static struct image_keyword xbm_format
[XBM_LAST
] =
6183 {":type", IMAGE_SYMBOL_VALUE
, 1},
6184 {":file", IMAGE_STRING_VALUE
, 0},
6185 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6186 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6187 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6188 {":foreground", IMAGE_STRING_VALUE
, 0},
6189 {":background", IMAGE_STRING_VALUE
, 0},
6190 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6191 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6192 {":relief", IMAGE_INTEGER_VALUE
, 0},
6193 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6194 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6195 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6198 /* Structure describing the image type XBM. */
6200 static struct image_type xbm_type
=
6209 /* Tokens returned from xbm_scan. */
6218 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6219 A valid specification is a list starting with the symbol `image'
6220 The rest of the list is a property list which must contain an
6223 If the specification specifies a file to load, it must contain
6224 an entry `:file FILENAME' where FILENAME is a string.
6226 If the specification is for a bitmap loaded from memory it must
6227 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6228 WIDTH and HEIGHT are integers > 0. DATA may be:
6230 1. a string large enough to hold the bitmap data, i.e. it must
6231 have a size >= (WIDTH + 7) / 8 * HEIGHT
6233 2. a bool-vector of size >= WIDTH * HEIGHT
6235 3. a vector of strings or bool-vectors, one for each line of the
6238 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6239 may not be specified in this case because they are defined in the
6242 Both the file and data forms may contain the additional entries
6243 `:background COLOR' and `:foreground COLOR'. If not present,
6244 foreground and background of the frame on which the image is
6245 displayed is used. */
6248 xbm_image_p (object
)
6251 struct image_keyword kw
[XBM_LAST
];
6253 bcopy (xbm_format
, kw
, sizeof kw
);
6254 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6257 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6259 if (kw
[XBM_FILE
].count
)
6261 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6264 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6266 /* In-memory XBM file. */
6267 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6275 /* Entries for `:width', `:height' and `:data' must be present. */
6276 if (!kw
[XBM_WIDTH
].count
6277 || !kw
[XBM_HEIGHT
].count
6278 || !kw
[XBM_DATA
].count
)
6281 data
= kw
[XBM_DATA
].value
;
6282 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6283 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6285 /* Check type of data, and width and height against contents of
6291 /* Number of elements of the vector must be >= height. */
6292 if (XVECTOR (data
)->size
< height
)
6295 /* Each string or bool-vector in data must be large enough
6296 for one line of the image. */
6297 for (i
= 0; i
< height
; ++i
)
6299 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6303 if (XSTRING (elt
)->size
6304 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6307 else if (BOOL_VECTOR_P (elt
))
6309 if (XBOOL_VECTOR (elt
)->size
< width
)
6316 else if (STRINGP (data
))
6318 if (XSTRING (data
)->size
6319 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6322 else if (BOOL_VECTOR_P (data
))
6324 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6335 /* Scan a bitmap file. FP is the stream to read from. Value is
6336 either an enumerator from enum xbm_token, or a character for a
6337 single-character token, or 0 at end of file. If scanning an
6338 identifier, store the lexeme of the identifier in SVAL. If
6339 scanning a number, store its value in *IVAL. */
6342 xbm_scan (s
, end
, sval
, ival
)
6351 /* Skip white space. */
6352 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6357 else if (isdigit (c
))
6359 int value
= 0, digit
;
6361 if (c
== '0' && *s
< end
)
6364 if (c
== 'x' || c
== 'X')
6371 else if (c
>= 'a' && c
<= 'f')
6372 digit
= c
- 'a' + 10;
6373 else if (c
>= 'A' && c
<= 'F')
6374 digit
= c
- 'A' + 10;
6377 value
= 16 * value
+ digit
;
6380 else if (isdigit (c
))
6384 && (c
= *(*s
)++, isdigit (c
)))
6385 value
= 8 * value
+ c
- '0';
6392 && (c
= *(*s
)++, isdigit (c
)))
6393 value
= 10 * value
+ c
- '0';
6401 else if (isalpha (c
) || c
== '_')
6405 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6412 else if (c
== '/' && **s
== '*')
6414 /* C-style comment. */
6416 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6429 /* Replacement for XReadBitmapFileData which isn't available under old
6430 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6431 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6432 the image. Return in *DATA the bitmap data allocated with xmalloc.
6433 Value is non-zero if successful. DATA null means just test if
6434 CONTENTS looks like an in-memory XBM file. */
6437 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6438 char *contents
, *end
;
6439 int *width
, *height
;
6440 unsigned char **data
;
6443 char buffer
[BUFSIZ
];
6446 int bytes_per_line
, i
, nbytes
;
6452 LA1 = xbm_scan (&s, end, buffer, &value)
6454 #define expect(TOKEN) \
6455 if (LA1 != (TOKEN)) \
6460 #define expect_ident(IDENT) \
6461 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6466 *width
= *height
= -1;
6469 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6471 /* Parse defines for width, height and hot-spots. */
6475 expect_ident ("define");
6476 expect (XBM_TK_IDENT
);
6478 if (LA1
== XBM_TK_NUMBER
);
6480 char *p
= strrchr (buffer
, '_');
6481 p
= p
? p
+ 1 : buffer
;
6482 if (strcmp (p
, "width") == 0)
6484 else if (strcmp (p
, "height") == 0)
6487 expect (XBM_TK_NUMBER
);
6490 if (*width
< 0 || *height
< 0)
6492 else if (data
== NULL
)
6495 /* Parse bits. Must start with `static'. */
6496 expect_ident ("static");
6497 if (LA1
== XBM_TK_IDENT
)
6499 if (strcmp (buffer
, "unsigned") == 0)
6502 expect_ident ("char");
6504 else if (strcmp (buffer
, "short") == 0)
6508 if (*width
% 16 && *width
% 16 < 9)
6511 else if (strcmp (buffer
, "char") == 0)
6519 expect (XBM_TK_IDENT
);
6525 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6526 nbytes
= bytes_per_line
* *height
;
6527 p
= *data
= (char *) xmalloc (nbytes
);
6531 for (i
= 0; i
< nbytes
; i
+= 2)
6534 expect (XBM_TK_NUMBER
);
6537 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6540 if (LA1
== ',' || LA1
== '}')
6548 for (i
= 0; i
< nbytes
; ++i
)
6551 expect (XBM_TK_NUMBER
);
6555 if (LA1
== ',' || LA1
== '}')
6580 /* Load XBM image IMG which will be displayed on frame F from buffer
6581 CONTENTS. END is the end of the buffer. Value is non-zero if
6585 xbm_load_image (f
, img
, contents
, end
)
6588 char *contents
, *end
;
6591 unsigned char *data
;
6594 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6597 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6598 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6599 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6602 xassert (img
->width
> 0 && img
->height
> 0);
6604 /* Get foreground and background colors, maybe allocate colors. */
6605 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6607 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6609 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6611 background
= x_alloc_image_color (f
, img
, value
, background
);
6614 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6617 img
->width
, img
->height
,
6618 foreground
, background
,
6622 if (img
->pixmap
== None
)
6624 x_clear_image (f
, img
);
6625 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6631 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6637 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6644 return (STRINGP (data
)
6645 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6646 (XSTRING (data
)->data
6647 + STRING_BYTES (XSTRING (data
))),
6652 /* Fill image IMG which is used on frame F with pixmap data. Value is
6653 non-zero if successful. */
6661 Lisp_Object file_name
;
6663 xassert (xbm_image_p (img
->spec
));
6665 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6666 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6667 if (STRINGP (file_name
))
6672 struct gcpro gcpro1
;
6674 file
= x_find_image_file (file_name
);
6676 if (!STRINGP (file
))
6678 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6683 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6684 if (contents
== NULL
)
6686 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6691 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6696 struct image_keyword fmt
[XBM_LAST
];
6698 unsigned char *bitmap_data
;
6700 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6701 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6703 int parsed_p
, height
, width
;
6704 int in_memory_file_p
= 0;
6706 /* See if data looks like an in-memory XBM file. */
6707 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6708 in_memory_file_p
= xbm_file_p (data
);
6710 /* Parse the image specification. */
6711 bcopy (xbm_format
, fmt
, sizeof fmt
);
6712 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6715 /* Get specified width, and height. */
6716 if (!in_memory_file_p
)
6718 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6719 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6720 xassert (img
->width
> 0 && img
->height
> 0);
6723 /* Get foreground and background colors, maybe allocate colors. */
6724 if (fmt
[XBM_FOREGROUND
].count
)
6725 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6727 if (fmt
[XBM_BACKGROUND
].count
)
6728 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6731 if (in_memory_file_p
)
6732 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6733 (XSTRING (data
)->data
6734 + STRING_BYTES (XSTRING (data
))));
6741 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6743 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6744 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6746 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6748 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6750 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6753 else if (STRINGP (data
))
6754 bits
= XSTRING (data
)->data
;
6756 bits
= XBOOL_VECTOR (data
)->data
;
6758 /* Create the pixmap. */
6759 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6761 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6764 img
->width
, img
->height
,
6765 foreground
, background
,
6771 image_error ("Unable to create pixmap for XBM image `%s'",
6773 x_clear_image (f
, img
);
6783 /***********************************************************************
6785 ***********************************************************************/
6789 static int xpm_image_p
P_ ((Lisp_Object object
));
6790 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6791 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6793 #include "X11/xpm.h"
6795 /* The symbol `xpm' identifying XPM-format images. */
6799 /* Indices of image specification fields in xpm_format, below. */
6801 enum xpm_keyword_index
6816 /* Vector of image_keyword structures describing the format
6817 of valid XPM image specifications. */
6819 static struct image_keyword xpm_format
[XPM_LAST
] =
6821 {":type", IMAGE_SYMBOL_VALUE
, 1},
6822 {":file", IMAGE_STRING_VALUE
, 0},
6823 {":data", IMAGE_STRING_VALUE
, 0},
6824 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6825 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6826 {":relief", IMAGE_INTEGER_VALUE
, 0},
6827 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6828 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6829 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6830 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6833 /* Structure describing the image type XBM. */
6835 static struct image_type xpm_type
=
6845 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6846 functions for allocating image colors. Our own functions handle
6847 color allocation failures more gracefully than the ones on the XPM
6850 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6851 #define ALLOC_XPM_COLORS
6854 #ifdef ALLOC_XPM_COLORS
6856 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
6857 static void xpm_free_color_cache
P_ ((void));
6858 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6859 static int xpm_color_bucket
P_ ((char *));
6860 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
6863 /* An entry in a hash table used to cache color definitions of named
6864 colors. This cache is necessary to speed up XPM image loading in
6865 case we do color allocations ourselves. Without it, we would need
6866 a call to XParseColor per pixel in the image. */
6868 struct xpm_cached_color
6870 /* Next in collision chain. */
6871 struct xpm_cached_color
*next
;
6873 /* Color definition (RGB and pixel color). */
6880 /* The hash table used for the color cache, and its bucket vector
6883 #define XPM_COLOR_CACHE_BUCKETS 1001
6884 struct xpm_cached_color
**xpm_color_cache
;
6886 /* Initialize the color cache. */
6889 xpm_init_color_cache (f
, attrs
)
6891 XpmAttributes
*attrs
;
6893 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
6894 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
6895 memset (xpm_color_cache
, 0, nbytes
);
6896 init_color_table ();
6898 if (attrs
->valuemask
& XpmColorSymbols
)
6903 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
6904 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
6905 attrs
->colorsymbols
[i
].value
, &color
))
6907 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
6909 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
6915 /* Free the color cache. */
6918 xpm_free_color_cache ()
6920 struct xpm_cached_color
*p
, *next
;
6923 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
6924 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
6930 xfree (xpm_color_cache
);
6931 xpm_color_cache
= NULL
;
6932 free_color_table ();
6936 /* Return the bucket index for color named COLOR_NAME in the color
6940 xpm_color_bucket (color_name
)
6946 for (s
= color_name
; *s
; ++s
)
6948 return h
%= XPM_COLOR_CACHE_BUCKETS
;
6952 /* On frame F, cache values COLOR for color with name COLOR_NAME.
6953 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
6956 static struct xpm_cached_color
*
6957 xpm_cache_color (f
, color_name
, color
, bucket
)
6964 struct xpm_cached_color
*p
;
6967 bucket
= xpm_color_bucket (color_name
);
6969 nbytes
= sizeof *p
+ strlen (color_name
);
6970 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
6971 strcpy (p
->name
, color_name
);
6973 p
->next
= xpm_color_cache
[bucket
];
6974 xpm_color_cache
[bucket
] = p
;
6979 /* Look up color COLOR_NAME for frame F in the color cache. If found,
6980 return the cached definition in *COLOR. Otherwise, make a new
6981 entry in the cache and allocate the color. Value is zero if color
6982 allocation failed. */
6985 xpm_lookup_color (f
, color_name
, color
)
6990 struct xpm_cached_color
*p
;
6991 int h
= xpm_color_bucket (color_name
);
6993 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
6994 if (strcmp (p
->name
, color_name
) == 0)
6999 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7002 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7004 p
= xpm_cache_color (f
, color_name
, color
, h
);
7011 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7012 CLOSURE is a pointer to the frame on which we allocate the
7013 color. Return in *COLOR the allocated color. Value is non-zero
7017 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7024 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7028 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7029 is a pointer to the frame on which we allocate the color. Value is
7030 non-zero if successful. */
7033 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7043 #endif /* ALLOC_XPM_COLORS */
7046 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7047 for XPM images. Such a list must consist of conses whose car and
7051 xpm_valid_color_symbols_p (color_symbols
)
7052 Lisp_Object color_symbols
;
7054 while (CONSP (color_symbols
))
7056 Lisp_Object sym
= XCAR (color_symbols
);
7058 || !STRINGP (XCAR (sym
))
7059 || !STRINGP (XCDR (sym
)))
7061 color_symbols
= XCDR (color_symbols
);
7064 return NILP (color_symbols
);
7068 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7071 xpm_image_p (object
)
7074 struct image_keyword fmt
[XPM_LAST
];
7075 bcopy (xpm_format
, fmt
, sizeof fmt
);
7076 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7077 /* Either `:file' or `:data' must be present. */
7078 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7079 /* Either no `:color-symbols' or it's a list of conses
7080 whose car and cdr are strings. */
7081 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7082 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7086 /* Load image IMG which will be displayed on frame F. Value is
7087 non-zero if successful. */
7095 XpmAttributes attrs
;
7096 Lisp_Object specified_file
, color_symbols
;
7098 /* Configure the XPM lib. Use the visual of frame F. Allocate
7099 close colors. Return colors allocated. */
7100 bzero (&attrs
, sizeof attrs
);
7101 attrs
.visual
= FRAME_X_VISUAL (f
);
7102 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7103 attrs
.valuemask
|= XpmVisual
;
7104 attrs
.valuemask
|= XpmColormap
;
7106 #ifdef ALLOC_XPM_COLORS
7107 /* Allocate colors with our own functions which handle
7108 failing color allocation more gracefully. */
7109 attrs
.color_closure
= f
;
7110 attrs
.alloc_color
= xpm_alloc_color
;
7111 attrs
.free_colors
= xpm_free_colors
;
7112 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7113 #else /* not ALLOC_XPM_COLORS */
7114 /* Let the XPM lib allocate colors. */
7115 attrs
.valuemask
|= XpmReturnAllocPixels
;
7116 #ifdef XpmAllocCloseColors
7117 attrs
.alloc_close_colors
= 1;
7118 attrs
.valuemask
|= XpmAllocCloseColors
;
7119 #else /* not XpmAllocCloseColors */
7120 attrs
.closeness
= 600;
7121 attrs
.valuemask
|= XpmCloseness
;
7122 #endif /* not XpmAllocCloseColors */
7123 #endif /* ALLOC_XPM_COLORS */
7125 /* If image specification contains symbolic color definitions, add
7126 these to `attrs'. */
7127 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7128 if (CONSP (color_symbols
))
7131 XpmColorSymbol
*xpm_syms
;
7134 attrs
.valuemask
|= XpmColorSymbols
;
7136 /* Count number of symbols. */
7137 attrs
.numsymbols
= 0;
7138 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7141 /* Allocate an XpmColorSymbol array. */
7142 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7143 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7144 bzero (xpm_syms
, size
);
7145 attrs
.colorsymbols
= xpm_syms
;
7147 /* Fill the color symbol array. */
7148 for (tail
= color_symbols
, i
= 0;
7150 ++i
, tail
= XCDR (tail
))
7152 Lisp_Object name
= XCAR (XCAR (tail
));
7153 Lisp_Object color
= XCDR (XCAR (tail
));
7154 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7155 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7156 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7157 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7161 /* Create a pixmap for the image, either from a file, or from a
7162 string buffer containing data in the same format as an XPM file. */
7163 #ifdef ALLOC_XPM_COLORS
7164 xpm_init_color_cache (f
, &attrs
);
7167 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7168 if (STRINGP (specified_file
))
7170 Lisp_Object file
= x_find_image_file (specified_file
);
7171 if (!STRINGP (file
))
7173 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7177 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7178 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7183 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7184 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7185 XSTRING (buffer
)->data
,
7186 &img
->pixmap
, &img
->mask
,
7190 if (rc
== XpmSuccess
)
7192 #ifdef ALLOC_XPM_COLORS
7193 img
->colors
= colors_in_color_table (&img
->ncolors
);
7194 #else /* not ALLOC_XPM_COLORS */
7195 img
->ncolors
= attrs
.nalloc_pixels
;
7196 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7197 * sizeof *img
->colors
);
7198 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7200 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7201 #ifdef DEBUG_X_COLORS
7202 register_color (img
->colors
[i
]);
7205 #endif /* not ALLOC_XPM_COLORS */
7207 img
->width
= attrs
.width
;
7208 img
->height
= attrs
.height
;
7209 xassert (img
->width
> 0 && img
->height
> 0);
7211 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7212 XpmFreeAttributes (&attrs
);
7219 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7222 case XpmFileInvalid
:
7223 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7227 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7230 case XpmColorFailed
:
7231 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7235 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7240 #ifdef ALLOC_XPM_COLORS
7241 xpm_free_color_cache ();
7243 return rc
== XpmSuccess
;
7246 #endif /* HAVE_XPM != 0 */
7249 /***********************************************************************
7251 ***********************************************************************/
7253 /* An entry in the color table mapping an RGB color to a pixel color. */
7258 unsigned long pixel
;
7260 /* Next in color table collision list. */
7261 struct ct_color
*next
;
7264 /* The bucket vector size to use. Must be prime. */
7268 /* Value is a hash of the RGB color given by R, G, and B. */
7270 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7272 /* The color hash table. */
7274 struct ct_color
**ct_table
;
7276 /* Number of entries in the color table. */
7278 int ct_colors_allocated
;
7280 /* Initialize the color table. */
7285 int size
= CT_SIZE
* sizeof (*ct_table
);
7286 ct_table
= (struct ct_color
**) xmalloc (size
);
7287 bzero (ct_table
, size
);
7288 ct_colors_allocated
= 0;
7292 /* Free memory associated with the color table. */
7298 struct ct_color
*p
, *next
;
7300 for (i
= 0; i
< CT_SIZE
; ++i
)
7301 for (p
= ct_table
[i
]; p
; p
= next
)
7312 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7313 entry for that color already is in the color table, return the
7314 pixel color of that entry. Otherwise, allocate a new color for R,
7315 G, B, and make an entry in the color table. */
7317 static unsigned long
7318 lookup_rgb_color (f
, r
, g
, b
)
7322 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7323 int i
= hash
% CT_SIZE
;
7326 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7327 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7340 cmap
= FRAME_X_COLORMAP (f
);
7341 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7345 ++ct_colors_allocated
;
7347 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7351 p
->pixel
= color
.pixel
;
7352 p
->next
= ct_table
[i
];
7356 return FRAME_FOREGROUND_PIXEL (f
);
7363 /* Look up pixel color PIXEL which is used on frame F in the color
7364 table. If not already present, allocate it. Value is PIXEL. */
7366 static unsigned long
7367 lookup_pixel_color (f
, pixel
)
7369 unsigned long pixel
;
7371 int i
= pixel
% CT_SIZE
;
7374 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7375 if (p
->pixel
== pixel
)
7384 cmap
= FRAME_X_COLORMAP (f
);
7385 color
.pixel
= pixel
;
7386 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7387 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7391 ++ct_colors_allocated
;
7393 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7398 p
->next
= ct_table
[i
];
7402 return FRAME_FOREGROUND_PIXEL (f
);
7409 /* Value is a vector of all pixel colors contained in the color table,
7410 allocated via xmalloc. Set *N to the number of colors. */
7412 static unsigned long *
7413 colors_in_color_table (n
)
7418 unsigned long *colors
;
7420 if (ct_colors_allocated
== 0)
7427 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7429 *n
= ct_colors_allocated
;
7431 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7432 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7433 colors
[j
++] = p
->pixel
;
7441 /***********************************************************************
7443 ***********************************************************************/
7445 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7446 int, XImage
*, int));
7447 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7448 XColor
*, int, XImage
*, int));
7449 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7450 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7451 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7453 /* Non-zero means draw a cross on images having `:algorithm
7456 int cross_disabled_images
;
7458 /* Edge detection matrices for different edge-detection
7461 static int emboss_matrix
[9] = {
7463 2, -1, 0, /* y - 1 */
7465 0, 1, -2 /* y + 1 */
7468 static int laplace_matrix
[9] = {
7470 1, 0, 0, /* y - 1 */
7472 0, 0, -1 /* y + 1 */
7475 /* Value is the intensity of the color whose red/green/blue values
7478 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7481 /* On frame F, return an array of XColor structures describing image
7482 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7483 non-zero means also fill the red/green/blue members of the XColor
7484 structures. Value is a pointer to the array of XColors structures,
7485 allocated with xmalloc; it must be freed by the caller. */
7488 x_to_xcolors (f
, img
, rgb_p
)
7497 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7499 /* Get the X image IMG->pixmap. */
7500 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7501 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7503 /* Fill the `pixel' members of the XColor array. I wished there
7504 were an easy and portable way to circumvent XGetPixel. */
7506 for (y
= 0; y
< img
->height
; ++y
)
7510 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7511 p
->pixel
= XGetPixel (ximg
, x
, y
);
7514 XQueryColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7518 XDestroyImage (ximg
);
7523 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7524 RGB members are set. F is the frame on which this all happens.
7525 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7528 x_from_xcolors (f
, img
, colors
)
7538 init_color_table ();
7540 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7543 for (y
= 0; y
< img
->height
; ++y
)
7544 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7546 unsigned long pixel
;
7547 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7548 XPutPixel (oimg
, x
, y
, pixel
);
7552 x_clear_image_1 (f
, img
, 1, 0, 1);
7554 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7555 x_destroy_x_image (oimg
);
7556 img
->pixmap
= pixmap
;
7557 img
->colors
= colors_in_color_table (&img
->ncolors
);
7558 free_color_table ();
7562 /* On frame F, perform edge-detection on image IMG.
7564 MATRIX is a nine-element array specifying the transformation
7565 matrix. See emboss_matrix for an example.
7567 COLOR_ADJUST is a color adjustment added to each pixel of the
7571 x_detect_edges (f
, img
, matrix
, color_adjust
)
7574 int matrix
[9], color_adjust
;
7576 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7580 for (i
= sum
= 0; i
< 9; ++i
)
7581 sum
+= abs (matrix
[i
]);
7583 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7585 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7587 for (y
= 0; y
< img
->height
; ++y
)
7589 p
= COLOR (new, 0, y
);
7590 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7591 p
= COLOR (new, img
->width
- 1, y
);
7592 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7595 for (x
= 1; x
< img
->width
- 1; ++x
)
7597 p
= COLOR (new, x
, 0);
7598 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7599 p
= COLOR (new, x
, img
->height
- 1);
7600 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7603 for (y
= 1; y
< img
->height
- 1; ++y
)
7605 p
= COLOR (new, 1, y
);
7607 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7609 int r
, g
, b
, y1
, x1
;
7612 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7613 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7616 XColor
*t
= COLOR (colors
, x1
, y1
);
7617 r
+= matrix
[i
] * t
->red
;
7618 g
+= matrix
[i
] * t
->green
;
7619 b
+= matrix
[i
] * t
->blue
;
7622 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7623 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7624 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7625 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7630 x_from_xcolors (f
, img
, new);
7636 /* Perform the pre-defined `emboss' edge-detection on image IMG
7644 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7648 /* Perform the pre-defined `laplace' edge-detection on image IMG
7656 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7660 /* Perform edge-detection on image IMG on frame F, with specified
7661 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7663 MATRIX must be either
7665 - a list of at least 9 numbers in row-major form
7666 - a vector of at least 9 numbers
7668 COLOR_ADJUST nil means use a default; otherwise it must be a
7672 x_edge_detection (f
, img
, matrix
, color_adjust
)
7675 Lisp_Object matrix
, color_adjust
;
7683 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7684 ++i
, matrix
= XCDR (matrix
))
7685 trans
[i
] = XFLOATINT (XCAR (matrix
));
7687 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7689 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7690 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7693 if (NILP (color_adjust
))
7694 color_adjust
= make_number (0xffff / 2);
7696 if (i
== 9 && NUMBERP (color_adjust
))
7697 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7701 /* Transform image IMG on frame F so that it looks disabled. */
7704 x_disable_image (f
, img
)
7708 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7710 if (dpyinfo
->n_planes
>= 2)
7712 /* Color (or grayscale). Convert to gray, and equalize. Just
7713 drawing such images with a stipple can look very odd, so
7714 we're using this method instead. */
7715 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7717 const int h
= 15000;
7718 const int l
= 30000;
7720 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7724 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7725 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7726 p
->red
= p
->green
= p
->blue
= i2
;
7729 x_from_xcolors (f
, img
, colors
);
7732 /* Draw a cross over the disabled image, if we must or if we
7734 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7736 Display
*dpy
= FRAME_X_DISPLAY (f
);
7739 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7740 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7741 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7742 img
->width
- 1, img
->height
- 1);
7743 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7749 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7750 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7751 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7752 img
->width
- 1, img
->height
- 1);
7753 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7761 /* Build a mask for image IMG which is used on frame F. FILE is the
7762 name of an image file, for error messages. HOW determines how to
7763 determine the background color of IMG. If it is a list '(R G B)',
7764 with R, G, and B being integers >= 0, take that as the color of the
7765 background. Otherwise, determine the background color of IMG
7766 heuristically. Value is non-zero if successful. */
7769 x_build_heuristic_mask (f
, img
, how
)
7774 Display
*dpy
= FRAME_X_DISPLAY (f
);
7775 XImage
*ximg
, *mask_img
;
7776 int x
, y
, rc
, look_at_corners_p
;
7777 unsigned long bg
= 0;
7781 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7785 /* Create an image and pixmap serving as mask. */
7786 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7787 &mask_img
, &img
->mask
);
7791 /* Get the X image of IMG->pixmap. */
7792 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7795 /* Determine the background color of ximg. If HOW is `(R G B)'
7796 take that as color. Otherwise, try to determine the color
7798 look_at_corners_p
= 1;
7806 && NATNUMP (XCAR (how
)))
7808 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7812 if (i
== 3 && NILP (how
))
7814 char color_name
[30];
7815 XColor exact
, color
;
7818 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7820 cmap
= FRAME_X_COLORMAP (f
);
7821 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7824 look_at_corners_p
= 0;
7829 if (look_at_corners_p
)
7831 unsigned long corners
[4];
7834 /* Get the colors at the corners of ximg. */
7835 corners
[0] = XGetPixel (ximg
, 0, 0);
7836 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7837 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7838 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7840 /* Choose the most frequently found color as background. */
7841 for (i
= best_count
= 0; i
< 4; ++i
)
7845 for (j
= n
= 0; j
< 4; ++j
)
7846 if (corners
[i
] == corners
[j
])
7850 bg
= corners
[i
], best_count
= n
;
7854 /* Set all bits in mask_img to 1 whose color in ximg is different
7855 from the background color bg. */
7856 for (y
= 0; y
< img
->height
; ++y
)
7857 for (x
= 0; x
< img
->width
; ++x
)
7858 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7860 /* Put mask_img into img->mask. */
7861 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7862 x_destroy_x_image (mask_img
);
7863 XDestroyImage (ximg
);
7870 /***********************************************************************
7871 PBM (mono, gray, color)
7872 ***********************************************************************/
7874 static int pbm_image_p
P_ ((Lisp_Object object
));
7875 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7876 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7878 /* The symbol `pbm' identifying images of this type. */
7882 /* Indices of image specification fields in gs_format, below. */
7884 enum pbm_keyword_index
7898 /* Vector of image_keyword structures describing the format
7899 of valid user-defined image specifications. */
7901 static struct image_keyword pbm_format
[PBM_LAST
] =
7903 {":type", IMAGE_SYMBOL_VALUE
, 1},
7904 {":file", IMAGE_STRING_VALUE
, 0},
7905 {":data", IMAGE_STRING_VALUE
, 0},
7906 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7907 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7908 {":relief", IMAGE_INTEGER_VALUE
, 0},
7909 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7910 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7911 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7914 /* Structure describing the image type `pbm'. */
7916 static struct image_type pbm_type
=
7926 /* Return non-zero if OBJECT is a valid PBM image specification. */
7929 pbm_image_p (object
)
7932 struct image_keyword fmt
[PBM_LAST
];
7934 bcopy (pbm_format
, fmt
, sizeof fmt
);
7936 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7939 /* Must specify either :data or :file. */
7940 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7944 /* Scan a decimal number from *S and return it. Advance *S while
7945 reading the number. END is the end of the string. Value is -1 at
7949 pbm_scan_number (s
, end
)
7950 unsigned char **s
, *end
;
7952 int c
= 0, val
= -1;
7956 /* Skip white-space. */
7957 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7962 /* Skip comment to end of line. */
7963 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7966 else if (isdigit (c
))
7968 /* Read decimal number. */
7970 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7971 val
= 10 * val
+ c
- '0';
7982 /* Load PBM image IMG for use on frame F. */
7990 int width
, height
, max_color_idx
= 0;
7992 Lisp_Object file
, specified_file
;
7993 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7994 struct gcpro gcpro1
;
7995 unsigned char *contents
= NULL
;
7996 unsigned char *end
, *p
;
7999 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8003 if (STRINGP (specified_file
))
8005 file
= x_find_image_file (specified_file
);
8006 if (!STRINGP (file
))
8008 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8013 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8014 if (contents
== NULL
)
8016 image_error ("Error reading `%s'", file
, Qnil
);
8022 end
= contents
+ size
;
8027 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8028 p
= XSTRING (data
)->data
;
8029 end
= p
+ STRING_BYTES (XSTRING (data
));
8032 /* Check magic number. */
8033 if (end
- p
< 2 || *p
++ != 'P')
8035 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8045 raw_p
= 0, type
= PBM_MONO
;
8049 raw_p
= 0, type
= PBM_GRAY
;
8053 raw_p
= 0, type
= PBM_COLOR
;
8057 raw_p
= 1, type
= PBM_MONO
;
8061 raw_p
= 1, type
= PBM_GRAY
;
8065 raw_p
= 1, type
= PBM_COLOR
;
8069 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8073 /* Read width, height, maximum color-component. Characters
8074 starting with `#' up to the end of a line are ignored. */
8075 width
= pbm_scan_number (&p
, end
);
8076 height
= pbm_scan_number (&p
, end
);
8078 if (type
!= PBM_MONO
)
8080 max_color_idx
= pbm_scan_number (&p
, end
);
8081 if (raw_p
&& max_color_idx
> 255)
8082 max_color_idx
= 255;
8087 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8090 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8091 &ximg
, &img
->pixmap
))
8094 /* Initialize the color hash table. */
8095 init_color_table ();
8097 if (type
== PBM_MONO
)
8101 for (y
= 0; y
< height
; ++y
)
8102 for (x
= 0; x
< width
; ++x
)
8112 g
= pbm_scan_number (&p
, end
);
8114 XPutPixel (ximg
, x
, y
, (g
8115 ? FRAME_FOREGROUND_PIXEL (f
)
8116 : FRAME_BACKGROUND_PIXEL (f
)));
8121 for (y
= 0; y
< height
; ++y
)
8122 for (x
= 0; x
< width
; ++x
)
8126 if (type
== PBM_GRAY
)
8127 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8136 r
= pbm_scan_number (&p
, end
);
8137 g
= pbm_scan_number (&p
, end
);
8138 b
= pbm_scan_number (&p
, end
);
8141 if (r
< 0 || g
< 0 || b
< 0)
8145 XDestroyImage (ximg
);
8146 image_error ("Invalid pixel value in image `%s'",
8151 /* RGB values are now in the range 0..max_color_idx.
8152 Scale this to the range 0..0xffff supported by X. */
8153 r
= (double) r
* 65535 / max_color_idx
;
8154 g
= (double) g
* 65535 / max_color_idx
;
8155 b
= (double) b
* 65535 / max_color_idx
;
8156 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8160 /* Store in IMG->colors the colors allocated for the image, and
8161 free the color table. */
8162 img
->colors
= colors_in_color_table (&img
->ncolors
);
8163 free_color_table ();
8165 /* Put the image into a pixmap. */
8166 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8167 x_destroy_x_image (ximg
);
8170 img
->height
= height
;
8179 /***********************************************************************
8181 ***********************************************************************/
8187 /* Function prototypes. */
8189 static int png_image_p
P_ ((Lisp_Object object
));
8190 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8192 /* The symbol `png' identifying images of this type. */
8196 /* Indices of image specification fields in png_format, below. */
8198 enum png_keyword_index
8212 /* Vector of image_keyword structures describing the format
8213 of valid user-defined image specifications. */
8215 static struct image_keyword png_format
[PNG_LAST
] =
8217 {":type", IMAGE_SYMBOL_VALUE
, 1},
8218 {":data", IMAGE_STRING_VALUE
, 0},
8219 {":file", IMAGE_STRING_VALUE
, 0},
8220 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8221 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8222 {":relief", IMAGE_INTEGER_VALUE
, 0},
8223 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8224 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8225 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8228 /* Structure describing the image type `png'. */
8230 static struct image_type png_type
=
8240 /* Return non-zero if OBJECT is a valid PNG image specification. */
8243 png_image_p (object
)
8246 struct image_keyword fmt
[PNG_LAST
];
8247 bcopy (png_format
, fmt
, sizeof fmt
);
8249 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8252 /* Must specify either the :data or :file keyword. */
8253 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8257 /* Error and warning handlers installed when the PNG library
8261 my_png_error (png_ptr
, msg
)
8262 png_struct
*png_ptr
;
8265 xassert (png_ptr
!= NULL
);
8266 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8267 longjmp (png_ptr
->jmpbuf
, 1);
8272 my_png_warning (png_ptr
, msg
)
8273 png_struct
*png_ptr
;
8276 xassert (png_ptr
!= NULL
);
8277 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8280 /* Memory source for PNG decoding. */
8282 struct png_memory_storage
8284 unsigned char *bytes
; /* The data */
8285 size_t len
; /* How big is it? */
8286 int index
; /* Where are we? */
8290 /* Function set as reader function when reading PNG image from memory.
8291 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8292 bytes from the input to DATA. */
8295 png_read_from_memory (png_ptr
, data
, length
)
8296 png_structp png_ptr
;
8300 struct png_memory_storage
*tbr
8301 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8303 if (length
> tbr
->len
- tbr
->index
)
8304 png_error (png_ptr
, "Read error");
8306 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8307 tbr
->index
= tbr
->index
+ length
;
8310 /* Load PNG image IMG for use on frame F. Value is non-zero if
8318 Lisp_Object file
, specified_file
;
8319 Lisp_Object specified_data
;
8321 XImage
*ximg
, *mask_img
= NULL
;
8322 struct gcpro gcpro1
;
8323 png_struct
*png_ptr
= NULL
;
8324 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8325 FILE *volatile fp
= NULL
;
8327 png_byte
* volatile pixels
= NULL
;
8328 png_byte
** volatile rows
= NULL
;
8329 png_uint_32 width
, height
;
8330 int bit_depth
, color_type
, interlace_type
;
8332 png_uint_32 row_bytes
;
8335 double screen_gamma
, image_gamma
;
8337 struct png_memory_storage tbr
; /* Data to be read */
8339 /* Find out what file to load. */
8340 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8341 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8345 if (NILP (specified_data
))
8347 file
= x_find_image_file (specified_file
);
8348 if (!STRINGP (file
))
8350 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8355 /* Open the image file. */
8356 fp
= fopen (XSTRING (file
)->data
, "rb");
8359 image_error ("Cannot open image file `%s'", file
, Qnil
);
8365 /* Check PNG signature. */
8366 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8367 || !png_check_sig (sig
, sizeof sig
))
8369 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8377 /* Read from memory. */
8378 tbr
.bytes
= XSTRING (specified_data
)->data
;
8379 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8382 /* Check PNG signature. */
8383 if (tbr
.len
< sizeof sig
8384 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8386 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8391 /* Need to skip past the signature. */
8392 tbr
.bytes
+= sizeof (sig
);
8395 /* Initialize read and info structs for PNG lib. */
8396 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8397 my_png_error
, my_png_warning
);
8400 if (fp
) fclose (fp
);
8405 info_ptr
= png_create_info_struct (png_ptr
);
8408 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8409 if (fp
) fclose (fp
);
8414 end_info
= png_create_info_struct (png_ptr
);
8417 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8418 if (fp
) fclose (fp
);
8423 /* Set error jump-back. We come back here when the PNG library
8424 detects an error. */
8425 if (setjmp (png_ptr
->jmpbuf
))
8429 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8432 if (fp
) fclose (fp
);
8437 /* Read image info. */
8438 if (!NILP (specified_data
))
8439 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8441 png_init_io (png_ptr
, fp
);
8443 png_set_sig_bytes (png_ptr
, sizeof sig
);
8444 png_read_info (png_ptr
, info_ptr
);
8445 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8446 &interlace_type
, NULL
, NULL
);
8448 /* If image contains simply transparency data, we prefer to
8449 construct a clipping mask. */
8450 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8455 /* This function is easier to write if we only have to handle
8456 one data format: RGB or RGBA with 8 bits per channel. Let's
8457 transform other formats into that format. */
8459 /* Strip more than 8 bits per channel. */
8460 if (bit_depth
== 16)
8461 png_set_strip_16 (png_ptr
);
8463 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8465 png_set_expand (png_ptr
);
8467 /* Convert grayscale images to RGB. */
8468 if (color_type
== PNG_COLOR_TYPE_GRAY
8469 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8470 png_set_gray_to_rgb (png_ptr
);
8472 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8473 gamma_str
= getenv ("SCREEN_GAMMA");
8474 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8476 /* Tell the PNG lib to handle gamma correction for us. */
8478 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8479 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8480 /* There is a special chunk in the image specifying the gamma. */
8481 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8484 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8485 /* Image contains gamma information. */
8486 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8488 /* Use a default of 0.5 for the image gamma. */
8489 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8491 /* Handle alpha channel by combining the image with a background
8492 color. Do this only if a real alpha channel is supplied. For
8493 simple transparency, we prefer a clipping mask. */
8496 png_color_16
*image_background
;
8498 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8499 /* Image contains a background color with which to
8500 combine the image. */
8501 png_set_background (png_ptr
, image_background
,
8502 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8505 /* Image does not contain a background color with which
8506 to combine the image data via an alpha channel. Use
8507 the frame's background instead. */
8510 png_color_16 frame_background
;
8512 cmap
= FRAME_X_COLORMAP (f
);
8513 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8514 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8516 bzero (&frame_background
, sizeof frame_background
);
8517 frame_background
.red
= color
.red
;
8518 frame_background
.green
= color
.green
;
8519 frame_background
.blue
= color
.blue
;
8521 png_set_background (png_ptr
, &frame_background
,
8522 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8526 /* Update info structure. */
8527 png_read_update_info (png_ptr
, info_ptr
);
8529 /* Get number of channels. Valid values are 1 for grayscale images
8530 and images with a palette, 2 for grayscale images with transparency
8531 information (alpha channel), 3 for RGB images, and 4 for RGB
8532 images with alpha channel, i.e. RGBA. If conversions above were
8533 sufficient we should only have 3 or 4 channels here. */
8534 channels
= png_get_channels (png_ptr
, info_ptr
);
8535 xassert (channels
== 3 || channels
== 4);
8537 /* Number of bytes needed for one row of the image. */
8538 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8540 /* Allocate memory for the image. */
8541 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8542 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8543 for (i
= 0; i
< height
; ++i
)
8544 rows
[i
] = pixels
+ i
* row_bytes
;
8546 /* Read the entire image. */
8547 png_read_image (png_ptr
, rows
);
8548 png_read_end (png_ptr
, info_ptr
);
8555 /* Create the X image and pixmap. */
8556 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8560 /* Create an image and pixmap serving as mask if the PNG image
8561 contains an alpha channel. */
8564 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8565 &mask_img
, &img
->mask
))
8567 x_destroy_x_image (ximg
);
8568 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8573 /* Fill the X image and mask from PNG data. */
8574 init_color_table ();
8576 for (y
= 0; y
< height
; ++y
)
8578 png_byte
*p
= rows
[y
];
8580 for (x
= 0; x
< width
; ++x
)
8587 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8589 /* An alpha channel, aka mask channel, associates variable
8590 transparency with an image. Where other image formats
8591 support binary transparency---fully transparent or fully
8592 opaque---PNG allows up to 254 levels of partial transparency.
8593 The PNG library implements partial transparency by combining
8594 the image with a specified background color.
8596 I'm not sure how to handle this here nicely: because the
8597 background on which the image is displayed may change, for
8598 real alpha channel support, it would be necessary to create
8599 a new image for each possible background.
8601 What I'm doing now is that a mask is created if we have
8602 boolean transparency information. Otherwise I'm using
8603 the frame's background color to combine the image with. */
8608 XPutPixel (mask_img
, x
, y
, *p
> 0);
8614 /* Remember colors allocated for this image. */
8615 img
->colors
= colors_in_color_table (&img
->ncolors
);
8616 free_color_table ();
8619 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8624 img
->height
= height
;
8626 /* Put the image into the pixmap, then free the X image and its buffer. */
8627 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8628 x_destroy_x_image (ximg
);
8630 /* Same for the mask. */
8633 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8634 x_destroy_x_image (mask_img
);
8641 #endif /* HAVE_PNG != 0 */
8645 /***********************************************************************
8647 ***********************************************************************/
8651 /* Work around a warning about HAVE_STDLIB_H being redefined in
8653 #ifdef HAVE_STDLIB_H
8654 #define HAVE_STDLIB_H_1
8655 #undef HAVE_STDLIB_H
8656 #endif /* HAVE_STLIB_H */
8658 #include <jpeglib.h>
8662 #ifdef HAVE_STLIB_H_1
8663 #define HAVE_STDLIB_H 1
8666 static int jpeg_image_p
P_ ((Lisp_Object object
));
8667 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8669 /* The symbol `jpeg' identifying images of this type. */
8673 /* Indices of image specification fields in gs_format, below. */
8675 enum jpeg_keyword_index
8684 JPEG_HEURISTIC_MASK
,
8689 /* Vector of image_keyword structures describing the format
8690 of valid user-defined image specifications. */
8692 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8694 {":type", IMAGE_SYMBOL_VALUE
, 1},
8695 {":data", IMAGE_STRING_VALUE
, 0},
8696 {":file", IMAGE_STRING_VALUE
, 0},
8697 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8698 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8699 {":relief", IMAGE_INTEGER_VALUE
, 0},
8700 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8701 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8702 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8705 /* Structure describing the image type `jpeg'. */
8707 static struct image_type jpeg_type
=
8717 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8720 jpeg_image_p (object
)
8723 struct image_keyword fmt
[JPEG_LAST
];
8725 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8727 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8730 /* Must specify either the :data or :file keyword. */
8731 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8735 struct my_jpeg_error_mgr
8737 struct jpeg_error_mgr pub
;
8738 jmp_buf setjmp_buffer
;
8743 my_error_exit (cinfo
)
8746 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8747 longjmp (mgr
->setjmp_buffer
, 1);
8751 /* Init source method for JPEG data source manager. Called by
8752 jpeg_read_header() before any data is actually read. See
8753 libjpeg.doc from the JPEG lib distribution. */
8756 our_init_source (cinfo
)
8757 j_decompress_ptr cinfo
;
8762 /* Fill input buffer method for JPEG data source manager. Called
8763 whenever more data is needed. We read the whole image in one step,
8764 so this only adds a fake end of input marker at the end. */
8767 our_fill_input_buffer (cinfo
)
8768 j_decompress_ptr cinfo
;
8770 /* Insert a fake EOI marker. */
8771 struct jpeg_source_mgr
*src
= cinfo
->src
;
8772 static JOCTET buffer
[2];
8774 buffer
[0] = (JOCTET
) 0xFF;
8775 buffer
[1] = (JOCTET
) JPEG_EOI
;
8777 src
->next_input_byte
= buffer
;
8778 src
->bytes_in_buffer
= 2;
8783 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8784 is the JPEG data source manager. */
8787 our_skip_input_data (cinfo
, num_bytes
)
8788 j_decompress_ptr cinfo
;
8791 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8795 if (num_bytes
> src
->bytes_in_buffer
)
8796 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8798 src
->bytes_in_buffer
-= num_bytes
;
8799 src
->next_input_byte
+= num_bytes
;
8804 /* Method to terminate data source. Called by
8805 jpeg_finish_decompress() after all data has been processed. */
8808 our_term_source (cinfo
)
8809 j_decompress_ptr cinfo
;
8814 /* Set up the JPEG lib for reading an image from DATA which contains
8815 LEN bytes. CINFO is the decompression info structure created for
8816 reading the image. */
8819 jpeg_memory_src (cinfo
, data
, len
)
8820 j_decompress_ptr cinfo
;
8824 struct jpeg_source_mgr
*src
;
8826 if (cinfo
->src
== NULL
)
8828 /* First time for this JPEG object? */
8829 cinfo
->src
= (struct jpeg_source_mgr
*)
8830 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8831 sizeof (struct jpeg_source_mgr
));
8832 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8833 src
->next_input_byte
= data
;
8836 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8837 src
->init_source
= our_init_source
;
8838 src
->fill_input_buffer
= our_fill_input_buffer
;
8839 src
->skip_input_data
= our_skip_input_data
;
8840 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8841 src
->term_source
= our_term_source
;
8842 src
->bytes_in_buffer
= len
;
8843 src
->next_input_byte
= data
;
8847 /* Load image IMG for use on frame F. Patterned after example.c
8848 from the JPEG lib. */
8855 struct jpeg_decompress_struct cinfo
;
8856 struct my_jpeg_error_mgr mgr
;
8857 Lisp_Object file
, specified_file
;
8858 Lisp_Object specified_data
;
8859 FILE * volatile fp
= NULL
;
8861 int row_stride
, x
, y
;
8862 XImage
*ximg
= NULL
;
8864 unsigned long *colors
;
8866 struct gcpro gcpro1
;
8868 /* Open the JPEG file. */
8869 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8870 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8874 if (NILP (specified_data
))
8876 file
= x_find_image_file (specified_file
);
8877 if (!STRINGP (file
))
8879 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8884 fp
= fopen (XSTRING (file
)->data
, "r");
8887 image_error ("Cannot open `%s'", file
, Qnil
);
8893 /* Customize libjpeg's error handling to call my_error_exit when an
8894 error is detected. This function will perform a longjmp. */
8895 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8896 mgr
.pub
.error_exit
= my_error_exit
;
8898 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8902 /* Called from my_error_exit. Display a JPEG error. */
8903 char buffer
[JMSG_LENGTH_MAX
];
8904 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8905 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8906 build_string (buffer
));
8909 /* Close the input file and destroy the JPEG object. */
8911 fclose ((FILE *) fp
);
8912 jpeg_destroy_decompress (&cinfo
);
8914 /* If we already have an XImage, free that. */
8915 x_destroy_x_image (ximg
);
8917 /* Free pixmap and colors. */
8918 x_clear_image (f
, img
);
8924 /* Create the JPEG decompression object. Let it read from fp.
8925 Read the JPEG image header. */
8926 jpeg_create_decompress (&cinfo
);
8928 if (NILP (specified_data
))
8929 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
8931 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8932 STRING_BYTES (XSTRING (specified_data
)));
8934 jpeg_read_header (&cinfo
, TRUE
);
8936 /* Customize decompression so that color quantization will be used.
8937 Start decompression. */
8938 cinfo
.quantize_colors
= TRUE
;
8939 jpeg_start_decompress (&cinfo
);
8940 width
= img
->width
= cinfo
.output_width
;
8941 height
= img
->height
= cinfo
.output_height
;
8943 /* Create X image and pixmap. */
8944 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8945 longjmp (mgr
.setjmp_buffer
, 2);
8947 /* Allocate colors. When color quantization is used,
8948 cinfo.actual_number_of_colors has been set with the number of
8949 colors generated, and cinfo.colormap is a two-dimensional array
8950 of color indices in the range 0..cinfo.actual_number_of_colors.
8951 No more than 255 colors will be generated. */
8955 if (cinfo
.out_color_components
> 2)
8956 ir
= 0, ig
= 1, ib
= 2;
8957 else if (cinfo
.out_color_components
> 1)
8958 ir
= 0, ig
= 1, ib
= 0;
8960 ir
= 0, ig
= 0, ib
= 0;
8962 /* Use the color table mechanism because it handles colors that
8963 cannot be allocated nicely. Such colors will be replaced with
8964 a default color, and we don't have to care about which colors
8965 can be freed safely, and which can't. */
8966 init_color_table ();
8967 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8970 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8972 /* Multiply RGB values with 255 because X expects RGB values
8973 in the range 0..0xffff. */
8974 int r
= cinfo
.colormap
[ir
][i
] << 8;
8975 int g
= cinfo
.colormap
[ig
][i
] << 8;
8976 int b
= cinfo
.colormap
[ib
][i
] << 8;
8977 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8980 /* Remember those colors actually allocated. */
8981 img
->colors
= colors_in_color_table (&img
->ncolors
);
8982 free_color_table ();
8986 row_stride
= width
* cinfo
.output_components
;
8987 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8989 for (y
= 0; y
< height
; ++y
)
8991 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8992 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8993 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8997 jpeg_finish_decompress (&cinfo
);
8998 jpeg_destroy_decompress (&cinfo
);
9000 fclose ((FILE *) fp
);
9002 /* Put the image into the pixmap. */
9003 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9004 x_destroy_x_image (ximg
);
9009 #endif /* HAVE_JPEG */
9013 /***********************************************************************
9015 ***********************************************************************/
9021 static int tiff_image_p
P_ ((Lisp_Object object
));
9022 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9024 /* The symbol `tiff' identifying images of this type. */
9028 /* Indices of image specification fields in tiff_format, below. */
9030 enum tiff_keyword_index
9039 TIFF_HEURISTIC_MASK
,
9044 /* Vector of image_keyword structures describing the format
9045 of valid user-defined image specifications. */
9047 static struct image_keyword tiff_format
[TIFF_LAST
] =
9049 {":type", IMAGE_SYMBOL_VALUE
, 1},
9050 {":data", IMAGE_STRING_VALUE
, 0},
9051 {":file", IMAGE_STRING_VALUE
, 0},
9052 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9053 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9054 {":relief", IMAGE_INTEGER_VALUE
, 0},
9055 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9056 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9057 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9060 /* Structure describing the image type `tiff'. */
9062 static struct image_type tiff_type
=
9072 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9075 tiff_image_p (object
)
9078 struct image_keyword fmt
[TIFF_LAST
];
9079 bcopy (tiff_format
, fmt
, sizeof fmt
);
9081 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9084 /* Must specify either the :data or :file keyword. */
9085 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9089 /* Reading from a memory buffer for TIFF images Based on the PNG
9090 memory source, but we have to provide a lot of extra functions.
9093 We really only need to implement read and seek, but I am not
9094 convinced that the TIFF library is smart enough not to destroy
9095 itself if we only hand it the function pointers we need to
9100 unsigned char *bytes
;
9108 tiff_read_from_memory (data
, buf
, size
)
9113 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9115 if (size
> src
->len
- src
->index
)
9117 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9124 tiff_write_from_memory (data
, buf
, size
)
9134 tiff_seek_in_memory (data
, off
, whence
)
9139 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9144 case SEEK_SET
: /* Go from beginning of source. */
9148 case SEEK_END
: /* Go from end of source. */
9149 idx
= src
->len
+ off
;
9152 case SEEK_CUR
: /* Go from current position. */
9153 idx
= src
->index
+ off
;
9156 default: /* Invalid `whence'. */
9160 if (idx
> src
->len
|| idx
< 0)
9169 tiff_close_memory (data
)
9178 tiff_mmap_memory (data
, pbase
, psize
)
9183 /* It is already _IN_ memory. */
9189 tiff_unmap_memory (data
, base
, size
)
9194 /* We don't need to do this. */
9199 tiff_size_of_memory (data
)
9202 return ((tiff_memory_source
*) data
)->len
;
9206 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9214 Lisp_Object file
, specified_file
;
9215 Lisp_Object specified_data
;
9217 int width
, height
, x
, y
;
9221 struct gcpro gcpro1
;
9222 tiff_memory_source memsrc
;
9224 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9225 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9229 if (NILP (specified_data
))
9231 /* Read from a file */
9232 file
= x_find_image_file (specified_file
);
9233 if (!STRINGP (file
))
9235 image_error ("Cannot find image file `%s'", file
, Qnil
);
9240 /* Try to open the image file. */
9241 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9244 image_error ("Cannot open `%s'", file
, Qnil
);
9251 /* Memory source! */
9252 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9253 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9256 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9257 (TIFFReadWriteProc
) tiff_read_from_memory
,
9258 (TIFFReadWriteProc
) tiff_write_from_memory
,
9259 tiff_seek_in_memory
,
9261 tiff_size_of_memory
,
9267 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9273 /* Get width and height of the image, and allocate a raster buffer
9274 of width x height 32-bit values. */
9275 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9276 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9277 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9279 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9283 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9289 /* Create the X image and pixmap. */
9290 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9297 /* Initialize the color table. */
9298 init_color_table ();
9300 /* Process the pixel raster. Origin is in the lower-left corner. */
9301 for (y
= 0; y
< height
; ++y
)
9303 uint32
*row
= buf
+ y
* width
;
9305 for (x
= 0; x
< width
; ++x
)
9307 uint32 abgr
= row
[x
];
9308 int r
= TIFFGetR (abgr
) << 8;
9309 int g
= TIFFGetG (abgr
) << 8;
9310 int b
= TIFFGetB (abgr
) << 8;
9311 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9315 /* Remember the colors allocated for the image. Free the color table. */
9316 img
->colors
= colors_in_color_table (&img
->ncolors
);
9317 free_color_table ();
9319 /* Put the image into the pixmap, then free the X image and its buffer. */
9320 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9321 x_destroy_x_image (ximg
);
9325 img
->height
= height
;
9331 #endif /* HAVE_TIFF != 0 */
9335 /***********************************************************************
9337 ***********************************************************************/
9341 #include <gif_lib.h>
9343 static int gif_image_p
P_ ((Lisp_Object object
));
9344 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9346 /* The symbol `gif' identifying images of this type. */
9350 /* Indices of image specification fields in gif_format, below. */
9352 enum gif_keyword_index
9367 /* Vector of image_keyword structures describing the format
9368 of valid user-defined image specifications. */
9370 static struct image_keyword gif_format
[GIF_LAST
] =
9372 {":type", IMAGE_SYMBOL_VALUE
, 1},
9373 {":data", IMAGE_STRING_VALUE
, 0},
9374 {":file", IMAGE_STRING_VALUE
, 0},
9375 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9376 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9377 {":relief", IMAGE_INTEGER_VALUE
, 0},
9378 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9379 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9380 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9381 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9384 /* Structure describing the image type `gif'. */
9386 static struct image_type gif_type
=
9396 /* Return non-zero if OBJECT is a valid GIF image specification. */
9399 gif_image_p (object
)
9402 struct image_keyword fmt
[GIF_LAST
];
9403 bcopy (gif_format
, fmt
, sizeof fmt
);
9405 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9408 /* Must specify either the :data or :file keyword. */
9409 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9413 /* Reading a GIF image from memory
9414 Based on the PNG memory stuff to a certain extent. */
9418 unsigned char *bytes
;
9425 /* Make the current memory source available to gif_read_from_memory.
9426 It's done this way because not all versions of libungif support
9427 a UserData field in the GifFileType structure. */
9428 static gif_memory_source
*current_gif_memory_src
;
9431 gif_read_from_memory (file
, buf
, len
)
9436 gif_memory_source
*src
= current_gif_memory_src
;
9438 if (len
> src
->len
- src
->index
)
9441 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9447 /* Load GIF image IMG for use on frame F. Value is non-zero if
9455 Lisp_Object file
, specified_file
;
9456 Lisp_Object specified_data
;
9457 int rc
, width
, height
, x
, y
, i
;
9459 ColorMapObject
*gif_color_map
;
9460 unsigned long pixel_colors
[256];
9462 struct gcpro gcpro1
;
9464 int ino
, image_left
, image_top
, image_width
, image_height
;
9465 gif_memory_source memsrc
;
9466 unsigned char *raster
;
9468 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9469 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9473 if (NILP (specified_data
))
9475 file
= x_find_image_file (specified_file
);
9476 if (!STRINGP (file
))
9478 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9483 /* Open the GIF file. */
9484 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9487 image_error ("Cannot open `%s'", file
, Qnil
);
9494 /* Read from memory! */
9495 current_gif_memory_src
= &memsrc
;
9496 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9497 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9500 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9503 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9509 /* Read entire contents. */
9510 rc
= DGifSlurp (gif
);
9511 if (rc
== GIF_ERROR
)
9513 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9514 DGifCloseFile (gif
);
9519 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9520 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9521 if (ino
>= gif
->ImageCount
)
9523 image_error ("Invalid image number `%s' in image `%s'",
9525 DGifCloseFile (gif
);
9530 width
= img
->width
= gif
->SWidth
;
9531 height
= img
->height
= gif
->SHeight
;
9533 /* Create the X image and pixmap. */
9534 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9536 DGifCloseFile (gif
);
9541 /* Allocate colors. */
9542 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9544 gif_color_map
= gif
->SColorMap
;
9545 init_color_table ();
9546 bzero (pixel_colors
, sizeof pixel_colors
);
9548 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9550 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9551 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9552 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9553 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9556 img
->colors
= colors_in_color_table (&img
->ncolors
);
9557 free_color_table ();
9559 /* Clear the part of the screen image that are not covered by
9560 the image from the GIF file. Full animated GIF support
9561 requires more than can be done here (see the gif89 spec,
9562 disposal methods). Let's simply assume that the part
9563 not covered by a sub-image is in the frame's background color. */
9564 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9565 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9566 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9567 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9569 for (y
= 0; y
< image_top
; ++y
)
9570 for (x
= 0; x
< width
; ++x
)
9571 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9573 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9574 for (x
= 0; x
< width
; ++x
)
9575 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9577 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9579 for (x
= 0; x
< image_left
; ++x
)
9580 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9581 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9582 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9585 /* Read the GIF image into the X image. We use a local variable
9586 `raster' here because RasterBits below is a char *, and invites
9587 problems with bytes >= 0x80. */
9588 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9590 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9592 static int interlace_start
[] = {0, 4, 2, 1};
9593 static int interlace_increment
[] = {8, 8, 4, 2};
9595 int row
= interlace_start
[0];
9599 for (y
= 0; y
< image_height
; y
++)
9601 if (row
>= image_height
)
9603 row
= interlace_start
[++pass
];
9604 while (row
>= image_height
)
9605 row
= interlace_start
[++pass
];
9608 for (x
= 0; x
< image_width
; x
++)
9610 int i
= raster
[(y
* image_width
) + x
];
9611 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9615 row
+= interlace_increment
[pass
];
9620 for (y
= 0; y
< image_height
; ++y
)
9621 for (x
= 0; x
< image_width
; ++x
)
9623 int i
= raster
[y
* image_width
+ x
];
9624 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9628 DGifCloseFile (gif
);
9630 /* Put the image into the pixmap, then free the X image and its buffer. */
9631 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9632 x_destroy_x_image (ximg
);
9638 #endif /* HAVE_GIF != 0 */
9642 /***********************************************************************
9644 ***********************************************************************/
9646 static int gs_image_p
P_ ((Lisp_Object object
));
9647 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9648 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9650 /* The symbol `postscript' identifying images of this type. */
9652 Lisp_Object Qpostscript
;
9654 /* Keyword symbols. */
9656 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9658 /* Indices of image specification fields in gs_format, below. */
9660 enum gs_keyword_index
9677 /* Vector of image_keyword structures describing the format
9678 of valid user-defined image specifications. */
9680 static struct image_keyword gs_format
[GS_LAST
] =
9682 {":type", IMAGE_SYMBOL_VALUE
, 1},
9683 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9684 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9685 {":file", IMAGE_STRING_VALUE
, 1},
9686 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9687 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9688 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9689 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9690 {":relief", IMAGE_INTEGER_VALUE
, 0},
9691 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9692 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9693 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9696 /* Structure describing the image type `ghostscript'. */
9698 static struct image_type gs_type
=
9708 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9711 gs_clear_image (f
, img
)
9715 /* IMG->data.ptr_val may contain a recorded colormap. */
9716 xfree (img
->data
.ptr_val
);
9717 x_clear_image (f
, img
);
9721 /* Return non-zero if OBJECT is a valid Ghostscript image
9728 struct image_keyword fmt
[GS_LAST
];
9732 bcopy (gs_format
, fmt
, sizeof fmt
);
9734 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9737 /* Bounding box must be a list or vector containing 4 integers. */
9738 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9741 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9742 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9747 else if (VECTORP (tem
))
9749 if (XVECTOR (tem
)->size
!= 4)
9751 for (i
= 0; i
< 4; ++i
)
9752 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9762 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9771 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9772 struct gcpro gcpro1
, gcpro2
;
9774 double in_width
, in_height
;
9775 Lisp_Object pixel_colors
= Qnil
;
9777 /* Compute pixel size of pixmap needed from the given size in the
9778 image specification. Sizes in the specification are in pt. 1 pt
9779 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9781 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9782 in_width
= XFASTINT (pt_width
) / 72.0;
9783 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9784 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9785 in_height
= XFASTINT (pt_height
) / 72.0;
9786 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9788 /* Create the pixmap. */
9789 xassert (img
->pixmap
== None
);
9790 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9791 img
->width
, img
->height
,
9792 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9796 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9800 /* Call the loader to fill the pixmap. It returns a process object
9801 if successful. We do not record_unwind_protect here because
9802 other places in redisplay like calling window scroll functions
9803 don't either. Let the Lisp loader use `unwind-protect' instead. */
9804 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9806 sprintf (buffer
, "%lu %lu",
9807 (unsigned long) FRAME_X_WINDOW (f
),
9808 (unsigned long) img
->pixmap
);
9809 window_and_pixmap_id
= build_string (buffer
);
9811 sprintf (buffer
, "%lu %lu",
9812 FRAME_FOREGROUND_PIXEL (f
),
9813 FRAME_BACKGROUND_PIXEL (f
));
9814 pixel_colors
= build_string (buffer
);
9816 XSETFRAME (frame
, f
);
9817 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9819 loader
= intern ("gs-load-image");
9821 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9822 make_number (img
->width
),
9823 make_number (img
->height
),
9824 window_and_pixmap_id
,
9827 return PROCESSP (img
->data
.lisp_val
);
9831 /* Kill the Ghostscript process that was started to fill PIXMAP on
9832 frame F. Called from XTread_socket when receiving an event
9833 telling Emacs that Ghostscript has finished drawing. */
9836 x_kill_gs_process (pixmap
, f
)
9840 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9844 /* Find the image containing PIXMAP. */
9845 for (i
= 0; i
< c
->used
; ++i
)
9846 if (c
->images
[i
]->pixmap
== pixmap
)
9849 /* Kill the GS process. We should have found PIXMAP in the image
9850 cache and its image should contain a process object. */
9851 xassert (i
< c
->used
);
9853 xassert (PROCESSP (img
->data
.lisp_val
));
9854 Fkill_process (img
->data
.lisp_val
, Qnil
);
9855 img
->data
.lisp_val
= Qnil
;
9857 /* On displays with a mutable colormap, figure out the colors
9858 allocated for the image by looking at the pixels of an XImage for
9860 class = FRAME_X_VISUAL (f
)->class;
9861 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9867 /* Try to get an XImage for img->pixmep. */
9868 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9869 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9874 /* Initialize the color table. */
9875 init_color_table ();
9877 /* For each pixel of the image, look its color up in the
9878 color table. After having done so, the color table will
9879 contain an entry for each color used by the image. */
9880 for (y
= 0; y
< img
->height
; ++y
)
9881 for (x
= 0; x
< img
->width
; ++x
)
9883 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9884 lookup_pixel_color (f
, pixel
);
9887 /* Record colors in the image. Free color table and XImage. */
9888 img
->colors
= colors_in_color_table (&img
->ncolors
);
9889 free_color_table ();
9890 XDestroyImage (ximg
);
9892 #if 0 /* This doesn't seem to be the case. If we free the colors
9893 here, we get a BadAccess later in x_clear_image when
9894 freeing the colors. */
9895 /* We have allocated colors once, but Ghostscript has also
9896 allocated colors on behalf of us. So, to get the
9897 reference counts right, free them once. */
9899 x_free_colors (f
, img
->colors
, img
->ncolors
);
9903 image_error ("Cannot get X image of `%s'; colors will not be freed",
9912 /***********************************************************************
9914 ***********************************************************************/
9916 DEFUN ("x-change-window-property", Fx_change_window_property
,
9917 Sx_change_window_property
, 2, 3, 0,
9918 "Change window property PROP to VALUE on the X window of FRAME.\n\
9919 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9920 selected frame. Value is VALUE.")
9921 (prop
, value
, frame
)
9922 Lisp_Object frame
, prop
, value
;
9924 struct frame
*f
= check_x_frame (frame
);
9927 CHECK_STRING (prop
, 1);
9928 CHECK_STRING (value
, 2);
9931 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9932 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9933 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9934 XSTRING (value
)->data
, XSTRING (value
)->size
);
9936 /* Make sure the property is set when we return. */
9937 XFlush (FRAME_X_DISPLAY (f
));
9944 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9945 Sx_delete_window_property
, 1, 2, 0,
9946 "Remove window property PROP from X window of FRAME.\n\
9947 FRAME nil or omitted means use the selected frame. Value is PROP.")
9949 Lisp_Object prop
, frame
;
9951 struct frame
*f
= check_x_frame (frame
);
9954 CHECK_STRING (prop
, 1);
9956 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9957 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9959 /* Make sure the property is removed when we return. */
9960 XFlush (FRAME_X_DISPLAY (f
));
9967 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9969 "Value is the value of window property PROP on FRAME.\n\
9970 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9971 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9974 Lisp_Object prop
, frame
;
9976 struct frame
*f
= check_x_frame (frame
);
9979 Lisp_Object prop_value
= Qnil
;
9980 char *tmp_data
= NULL
;
9983 unsigned long actual_size
, bytes_remaining
;
9985 CHECK_STRING (prop
, 1);
9987 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9988 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9989 prop_atom
, 0, 0, False
, XA_STRING
,
9990 &actual_type
, &actual_format
, &actual_size
,
9991 &bytes_remaining
, (unsigned char **) &tmp_data
);
9994 int size
= bytes_remaining
;
9999 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10000 prop_atom
, 0, bytes_remaining
,
10002 &actual_type
, &actual_format
,
10003 &actual_size
, &bytes_remaining
,
10004 (unsigned char **) &tmp_data
);
10006 prop_value
= make_string (tmp_data
, size
);
10017 /***********************************************************************
10019 ***********************************************************************/
10021 /* If non-null, an asynchronous timer that, when it expires, displays
10022 a busy cursor on all frames. */
10024 static struct atimer
*busy_cursor_atimer
;
10026 /* Non-zero means a busy cursor is currently shown. */
10028 static int busy_cursor_shown_p
;
10030 /* Number of seconds to wait before displaying a busy cursor. */
10032 static Lisp_Object Vbusy_cursor_delay
;
10034 /* Default number of seconds to wait before displaying a busy
10037 #define DEFAULT_BUSY_CURSOR_DELAY 1
10039 /* Function prototypes. */
10041 static void show_busy_cursor
P_ ((struct atimer
*));
10042 static void hide_busy_cursor
P_ ((void));
10045 /* Cancel a currently active busy-cursor timer, and start a new one. */
10048 start_busy_cursor ()
10051 int secs
, usecs
= 0;
10053 cancel_busy_cursor ();
10055 if (INTEGERP (Vbusy_cursor_delay
)
10056 && XINT (Vbusy_cursor_delay
) > 0)
10057 secs
= XFASTINT (Vbusy_cursor_delay
);
10058 else if (FLOATP (Vbusy_cursor_delay
)
10059 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10062 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10063 secs
= XFASTINT (tem
);
10064 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10067 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10069 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10070 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10071 show_busy_cursor
, NULL
);
10075 /* Cancel the busy cursor timer if active, hide a busy cursor if
10079 cancel_busy_cursor ()
10081 if (busy_cursor_atimer
)
10083 cancel_atimer (busy_cursor_atimer
);
10084 busy_cursor_atimer
= NULL
;
10087 if (busy_cursor_shown_p
)
10088 hide_busy_cursor ();
10092 /* Timer function of busy_cursor_atimer. TIMER is equal to
10093 busy_cursor_atimer.
10095 Display a busy cursor on all frames by mapping the frames'
10096 busy_window. Set the busy_p flag in the frames' output_data.x
10097 structure to indicate that a busy cursor is shown on the
10101 show_busy_cursor (timer
)
10102 struct atimer
*timer
;
10104 /* The timer implementation will cancel this timer automatically
10105 after this function has run. Set busy_cursor_atimer to null
10106 so that we know the timer doesn't have to be canceled. */
10107 busy_cursor_atimer
= NULL
;
10109 if (!busy_cursor_shown_p
)
10111 Lisp_Object rest
, frame
;
10115 FOR_EACH_FRAME (rest
, frame
)
10116 if (FRAME_X_P (XFRAME (frame
)))
10118 struct frame
*f
= XFRAME (frame
);
10120 f
->output_data
.x
->busy_p
= 1;
10122 if (!f
->output_data
.x
->busy_window
)
10124 unsigned long mask
= CWCursor
;
10125 XSetWindowAttributes attrs
;
10127 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10129 f
->output_data
.x
->busy_window
10130 = XCreateWindow (FRAME_X_DISPLAY (f
),
10131 FRAME_OUTER_WINDOW (f
),
10132 0, 0, 32000, 32000, 0, 0,
10138 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10139 XFlush (FRAME_X_DISPLAY (f
));
10142 busy_cursor_shown_p
= 1;
10148 /* Hide the busy cursor on all frames, if it is currently shown. */
10151 hide_busy_cursor ()
10153 if (busy_cursor_shown_p
)
10155 Lisp_Object rest
, frame
;
10158 FOR_EACH_FRAME (rest
, frame
)
10160 struct frame
*f
= XFRAME (frame
);
10163 /* Watch out for newly created frames. */
10164 && f
->output_data
.x
->busy_window
)
10166 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10167 /* Sync here because XTread_socket looks at the busy_p flag
10168 that is reset to zero below. */
10169 XSync (FRAME_X_DISPLAY (f
), False
);
10170 f
->output_data
.x
->busy_p
= 0;
10174 busy_cursor_shown_p
= 0;
10181 /***********************************************************************
10183 ***********************************************************************/
10185 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10188 /* The frame of a currently visible tooltip, or null. */
10190 struct frame
*tip_frame
;
10192 /* If non-nil, a timer started that hides the last tooltip when it
10195 Lisp_Object tip_timer
;
10198 /* Create a frame for a tooltip on the display described by DPYINFO.
10199 PARMS is a list of frame parameters. Value is the frame. */
10202 x_create_tip_frame (dpyinfo
, parms
)
10203 struct x_display_info
*dpyinfo
;
10207 Lisp_Object frame
, tem
;
10209 long window_prompting
= 0;
10211 int count
= specpdl_ptr
- specpdl
;
10212 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10217 /* Use this general default value to start with until we know if
10218 this frame has a specified name. */
10219 Vx_resource_name
= Vinvocation_name
;
10221 #ifdef MULTI_KBOARD
10222 kb
= dpyinfo
->kboard
;
10224 kb
= &the_only_kboard
;
10227 /* Get the name of the frame to use for resource lookup. */
10228 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10229 if (!STRINGP (name
)
10230 && !EQ (name
, Qunbound
)
10232 error ("Invalid frame name--not a string or nil");
10233 Vx_resource_name
= name
;
10236 GCPRO3 (parms
, name
, frame
);
10237 tip_frame
= f
= make_frame (1);
10238 XSETFRAME (frame
, f
);
10239 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10241 f
->output_method
= output_x_window
;
10242 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10243 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10244 f
->output_data
.x
->icon_bitmap
= -1;
10245 f
->output_data
.x
->fontset
= -1;
10246 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10247 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10248 f
->icon_name
= Qnil
;
10249 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10250 #ifdef MULTI_KBOARD
10251 FRAME_KBOARD (f
) = kb
;
10253 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10254 f
->output_data
.x
->explicit_parent
= 0;
10256 /* These colors will be set anyway later, but it's important
10257 to get the color reference counts right, so initialize them! */
10260 struct gcpro gcpro1
;
10262 black
= build_string ("black");
10264 f
->output_data
.x
->foreground_pixel
10265 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10266 f
->output_data
.x
->background_pixel
10267 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10268 f
->output_data
.x
->cursor_pixel
10269 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10270 f
->output_data
.x
->cursor_foreground_pixel
10271 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10272 f
->output_data
.x
->border_pixel
10273 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10274 f
->output_data
.x
->mouse_pixel
10275 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10279 /* Set the name; the functions to which we pass f expect the name to
10281 if (EQ (name
, Qunbound
) || NILP (name
))
10283 f
->name
= build_string (dpyinfo
->x_id_name
);
10284 f
->explicit_name
= 0;
10289 f
->explicit_name
= 1;
10290 /* use the frame's title when getting resources for this frame. */
10291 specbind (Qx_resource_name
, name
);
10294 /* Extract the window parameters from the supplied values
10295 that are needed to determine window geometry. */
10299 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10302 /* First, try whatever font the caller has specified. */
10303 if (STRINGP (font
))
10305 tem
= Fquery_fontset (font
, Qnil
);
10307 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10309 font
= x_new_font (f
, XSTRING (font
)->data
);
10312 /* Try out a font which we hope has bold and italic variations. */
10313 if (!STRINGP (font
))
10314 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10315 if (!STRINGP (font
))
10316 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10317 if (! STRINGP (font
))
10318 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10319 if (! STRINGP (font
))
10320 /* This was formerly the first thing tried, but it finds too many fonts
10321 and takes too long. */
10322 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10323 /* If those didn't work, look for something which will at least work. */
10324 if (! STRINGP (font
))
10325 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10327 if (! STRINGP (font
))
10328 font
= build_string ("fixed");
10330 x_default_parameter (f
, parms
, Qfont
, font
,
10331 "font", "Font", RES_TYPE_STRING
);
10334 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10335 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10337 /* This defaults to 2 in order to match xterm. We recognize either
10338 internalBorderWidth or internalBorder (which is what xterm calls
10340 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10344 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10345 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10346 if (! EQ (value
, Qunbound
))
10347 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10351 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10352 "internalBorderWidth", "internalBorderWidth",
10355 /* Also do the stuff which must be set before the window exists. */
10356 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10357 "foreground", "Foreground", RES_TYPE_STRING
);
10358 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10359 "background", "Background", RES_TYPE_STRING
);
10360 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10361 "pointerColor", "Foreground", RES_TYPE_STRING
);
10362 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10363 "cursorColor", "Foreground", RES_TYPE_STRING
);
10364 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10365 "borderColor", "BorderColor", RES_TYPE_STRING
);
10367 /* Init faces before x_default_parameter is called for scroll-bar
10368 parameters because that function calls x_set_scroll_bar_width,
10369 which calls change_frame_size, which calls Fset_window_buffer,
10370 which runs hooks, which call Fvertical_motion. At the end, we
10371 end up in init_iterator with a null face cache, which should not
10373 init_frame_faces (f
);
10375 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10376 window_prompting
= x_figure_window_size (f
, parms
);
10378 if (window_prompting
& XNegative
)
10380 if (window_prompting
& YNegative
)
10381 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10383 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10387 if (window_prompting
& YNegative
)
10388 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10390 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10393 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10395 XSetWindowAttributes attrs
;
10396 unsigned long mask
;
10399 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10400 /* Window managers look at the override-redirect flag to determine
10401 whether or net to give windows a decoration (Xlib spec, chapter
10403 attrs
.override_redirect
= True
;
10404 attrs
.save_under
= True
;
10405 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10406 /* Arrange for getting MapNotify and UnmapNotify events. */
10407 attrs
.event_mask
= StructureNotifyMask
;
10409 = FRAME_X_WINDOW (f
)
10410 = XCreateWindow (FRAME_X_DISPLAY (f
),
10411 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10412 /* x, y, width, height */
10416 CopyFromParent
, InputOutput
, CopyFromParent
,
10423 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10424 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10425 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10426 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10427 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10428 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10430 /* Dimensions, especially f->height, must be done via change_frame_size.
10431 Change will not be effected unless different from the current
10434 height
= f
->height
;
10436 SET_FRAME_WIDTH (f
, 0);
10437 change_frame_size (f
, height
, width
, 1, 0, 0);
10443 /* It is now ok to make the frame official even if we get an error
10444 below. And the frame needs to be on Vframe_list or making it
10445 visible won't work. */
10446 Vframe_list
= Fcons (frame
, Vframe_list
);
10448 /* Now that the frame is official, it counts as a reference to
10450 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10452 return unbind_to (count
, frame
);
10456 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10457 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10458 A tooltip window is a small X window displaying a string.\n\
10460 FRAME nil or omitted means use the selected frame.\n\
10462 PARMS is an optional list of frame parameters which can be\n\
10463 used to change the tooltip's appearance.\n\
10465 Automatically hide the tooltip after TIMEOUT seconds.\n\
10466 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10468 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10469 the tooltip is displayed at that x-position. Otherwise it is\n\
10470 displayed at the mouse position, with offset DX added (default is 5 if\n\
10471 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10472 parameter is specified, it determines the y-position of the tooltip\n\
10473 window, otherwise it is displayed at the mouse position, with offset\n\
10474 DY added (default is -5).")
10475 (string
, frame
, parms
, timeout
, dx
, dy
)
10476 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10480 Window root
, child
;
10481 Lisp_Object buffer
, top
, left
;
10482 struct buffer
*old_buffer
;
10483 struct text_pos pos
;
10484 int i
, width
, height
;
10485 int root_x
, root_y
, win_x
, win_y
;
10487 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10488 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10489 int count
= specpdl_ptr
- specpdl
;
10491 specbind (Qinhibit_redisplay
, Qt
);
10493 GCPRO4 (string
, parms
, frame
, timeout
);
10495 CHECK_STRING (string
, 0);
10496 f
= check_x_frame (frame
);
10497 if (NILP (timeout
))
10498 timeout
= make_number (5);
10500 CHECK_NATNUM (timeout
, 2);
10503 dx
= make_number (5);
10505 CHECK_NUMBER (dx
, 5);
10508 dy
= make_number (-5);
10510 CHECK_NUMBER (dy
, 6);
10512 /* Hide a previous tip, if any. */
10515 /* Add default values to frame parameters. */
10516 if (NILP (Fassq (Qname
, parms
)))
10517 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10518 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10519 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10520 if (NILP (Fassq (Qborder_width
, parms
)))
10521 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10522 if (NILP (Fassq (Qborder_color
, parms
)))
10523 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10524 if (NILP (Fassq (Qbackground_color
, parms
)))
10525 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10528 /* Create a frame for the tooltip, and record it in the global
10529 variable tip_frame. */
10530 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10531 tip_frame
= f
= XFRAME (frame
);
10533 /* Set up the frame's root window. Currently we use a size of 80
10534 columns x 40 lines. If someone wants to show a larger tip, he
10535 will loose. I don't think this is a realistic case. */
10536 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10537 w
->left
= w
->top
= make_number (0);
10538 w
->width
= make_number (80);
10539 w
->height
= make_number (40);
10541 w
->pseudo_window_p
= 1;
10543 /* Display the tooltip text in a temporary buffer. */
10544 buffer
= Fget_buffer_create (build_string (" *tip*"));
10545 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10546 old_buffer
= current_buffer
;
10547 set_buffer_internal_1 (XBUFFER (buffer
));
10549 Finsert (1, &string
);
10550 clear_glyph_matrix (w
->desired_matrix
);
10551 clear_glyph_matrix (w
->current_matrix
);
10552 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10553 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10555 /* Compute width and height of the tooltip. */
10556 width
= height
= 0;
10557 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10559 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10560 struct glyph
*last
;
10563 /* Stop at the first empty row at the end. */
10564 if (!row
->enabled_p
|| !row
->displays_text_p
)
10567 /* Let the row go over the full width of the frame. */
10568 row
->full_width_p
= 1;
10570 /* There's a glyph at the end of rows that is used to place
10571 the cursor there. Don't include the width of this glyph. */
10572 if (row
->used
[TEXT_AREA
])
10574 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10575 row_width
= row
->pixel_width
- last
->pixel_width
;
10578 row_width
= row
->pixel_width
;
10580 height
+= row
->height
;
10581 width
= max (width
, row_width
);
10584 /* Add the frame's internal border to the width and height the X
10585 window should have. */
10586 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10587 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10589 /* User-specified position? */
10590 left
= Fcdr (Fassq (Qleft
, parms
));
10591 top
= Fcdr (Fassq (Qtop
, parms
));
10593 /* Move the tooltip window where the mouse pointer is. Resize and
10596 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10597 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10600 root_x
+= XINT (dx
);
10601 root_y
+= XINT (dy
);
10603 if (INTEGERP (left
))
10604 root_x
= XINT (left
);
10605 if (INTEGERP (top
))
10606 root_y
= XINT (top
);
10609 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10610 root_x
, root_y
- height
, width
, height
);
10611 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10614 /* Draw into the window. */
10615 w
->must_be_updated_p
= 1;
10616 update_single_window (w
, 1);
10618 /* Restore original current buffer. */
10619 set_buffer_internal_1 (old_buffer
);
10620 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10622 /* Let the tip disappear after timeout seconds. */
10623 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10624 intern ("x-hide-tip"));
10627 return unbind_to (count
, Qnil
);
10631 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10632 "Hide the current tooltip window, if there is any.\n\
10633 Value is t is tooltip was open, nil otherwise.")
10636 int count
= specpdl_ptr
- specpdl
;
10639 specbind (Qinhibit_redisplay
, Qt
);
10641 if (!NILP (tip_timer
))
10643 call1 (intern ("cancel-timer"), tip_timer
);
10651 XSETFRAME (frame
, tip_frame
);
10652 Fdelete_frame (frame
, Qt
);
10657 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10662 /***********************************************************************
10663 File selection dialog
10664 ***********************************************************************/
10668 /* Callback for "OK" and "Cancel" on file selection dialog. */
10671 file_dialog_cb (widget
, client_data
, call_data
)
10673 XtPointer call_data
, client_data
;
10675 int *result
= (int *) client_data
;
10676 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10677 *result
= cb
->reason
;
10681 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10682 "Read file name, prompting with PROMPT in directory DIR.\n\
10683 Use a file selection dialog.\n\
10684 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10685 specified. Don't let the user enter a file name in the file\n\
10686 selection dialog's entry field, if MUSTMATCH is non-nil.")
10687 (prompt
, dir
, default_filename
, mustmatch
)
10688 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10691 struct frame
*f
= SELECTED_FRAME ();
10692 Lisp_Object file
= Qnil
;
10693 Widget dialog
, text
, list
, help
;
10696 extern XtAppContext Xt_app_con
;
10698 XmString dir_xmstring
, pattern_xmstring
;
10699 int popup_activated_flag
;
10700 int count
= specpdl_ptr
- specpdl
;
10701 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10703 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10704 CHECK_STRING (prompt
, 0);
10705 CHECK_STRING (dir
, 1);
10707 /* Prevent redisplay. */
10708 specbind (Qinhibit_redisplay
, Qt
);
10712 /* Create the dialog with PROMPT as title, using DIR as initial
10713 directory and using "*" as pattern. */
10714 dir
= Fexpand_file_name (dir
, Qnil
);
10715 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10716 pattern_xmstring
= XmStringCreateLocalized ("*");
10718 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10719 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10720 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10721 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10722 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10723 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10725 XmStringFree (dir_xmstring
);
10726 XmStringFree (pattern_xmstring
);
10728 /* Add callbacks for OK and Cancel. */
10729 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10730 (XtPointer
) &result
);
10731 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10732 (XtPointer
) &result
);
10734 /* Disable the help button since we can't display help. */
10735 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10736 XtSetSensitive (help
, False
);
10738 /* Mark OK button as default. */
10739 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10740 XmNshowAsDefault
, True
, NULL
);
10742 /* If MUSTMATCH is non-nil, disable the file entry field of the
10743 dialog, so that the user must select a file from the files list
10744 box. We can't remove it because we wouldn't have a way to get at
10745 the result file name, then. */
10746 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10747 if (!NILP (mustmatch
))
10750 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10751 XtSetSensitive (text
, False
);
10752 XtSetSensitive (label
, False
);
10755 /* Manage the dialog, so that list boxes get filled. */
10756 XtManageChild (dialog
);
10758 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10759 must include the path for this to work. */
10760 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10761 if (STRINGP (default_filename
))
10763 XmString default_xmstring
;
10767 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10769 if (!XmListItemExists (list
, default_xmstring
))
10771 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10772 XmListAddItem (list
, default_xmstring
, 0);
10776 item_pos
= XmListItemPos (list
, default_xmstring
);
10777 XmStringFree (default_xmstring
);
10779 /* Select the item and scroll it into view. */
10780 XmListSelectPos (list
, item_pos
, True
);
10781 XmListSetPos (list
, item_pos
);
10784 #ifdef HAVE_MOTIF_2_1
10786 /* Process events until the user presses Cancel or OK. */
10788 while (result
== 0 || XtAppPending (Xt_app_con
))
10789 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10791 #else /* not HAVE_MOTIF_2_1 */
10793 /* Process all events until the user presses Cancel or OK. */
10794 for (result
= 0; result
== 0;)
10797 Widget widget
, parent
;
10799 XtAppNextEvent (Xt_app_con
, &event
);
10801 /* See if the receiver of the event is one of the widgets of
10802 the file selection dialog. If so, dispatch it. If not,
10804 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10806 while (parent
&& parent
!= dialog
)
10807 parent
= XtParent (parent
);
10809 if (parent
== dialog
10810 || (event
.type
== Expose
10811 && !process_expose_from_menu (event
)))
10812 XtDispatchEvent (&event
);
10815 #endif /* not HAVE_MOTIF_2_1 */
10817 /* Get the result. */
10818 if (result
== XmCR_OK
)
10823 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
10824 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10825 XmStringFree (text
);
10826 file
= build_string (data
);
10833 XtUnmanageChild (dialog
);
10834 XtDestroyWidget (dialog
);
10838 /* Make "Cancel" equivalent to C-g. */
10840 Fsignal (Qquit
, Qnil
);
10842 return unbind_to (count
, file
);
10845 #endif /* USE_MOTIF */
10849 /***********************************************************************
10851 ***********************************************************************/
10856 /* This is zero if not using X windows. */
10859 /* The section below is built by the lisp expression at the top of the file,
10860 just above where these variables are declared. */
10861 /*&&& init symbols here &&&*/
10862 Qauto_raise
= intern ("auto-raise");
10863 staticpro (&Qauto_raise
);
10864 Qauto_lower
= intern ("auto-lower");
10865 staticpro (&Qauto_lower
);
10866 Qbar
= intern ("bar");
10868 Qborder_color
= intern ("border-color");
10869 staticpro (&Qborder_color
);
10870 Qborder_width
= intern ("border-width");
10871 staticpro (&Qborder_width
);
10872 Qbox
= intern ("box");
10874 Qcursor_color
= intern ("cursor-color");
10875 staticpro (&Qcursor_color
);
10876 Qcursor_type
= intern ("cursor-type");
10877 staticpro (&Qcursor_type
);
10878 Qgeometry
= intern ("geometry");
10879 staticpro (&Qgeometry
);
10880 Qicon_left
= intern ("icon-left");
10881 staticpro (&Qicon_left
);
10882 Qicon_top
= intern ("icon-top");
10883 staticpro (&Qicon_top
);
10884 Qicon_type
= intern ("icon-type");
10885 staticpro (&Qicon_type
);
10886 Qicon_name
= intern ("icon-name");
10887 staticpro (&Qicon_name
);
10888 Qinternal_border_width
= intern ("internal-border-width");
10889 staticpro (&Qinternal_border_width
);
10890 Qleft
= intern ("left");
10891 staticpro (&Qleft
);
10892 Qright
= intern ("right");
10893 staticpro (&Qright
);
10894 Qmouse_color
= intern ("mouse-color");
10895 staticpro (&Qmouse_color
);
10896 Qnone
= intern ("none");
10897 staticpro (&Qnone
);
10898 Qparent_id
= intern ("parent-id");
10899 staticpro (&Qparent_id
);
10900 Qscroll_bar_width
= intern ("scroll-bar-width");
10901 staticpro (&Qscroll_bar_width
);
10902 Qsuppress_icon
= intern ("suppress-icon");
10903 staticpro (&Qsuppress_icon
);
10904 Qundefined_color
= intern ("undefined-color");
10905 staticpro (&Qundefined_color
);
10906 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10907 staticpro (&Qvertical_scroll_bars
);
10908 Qvisibility
= intern ("visibility");
10909 staticpro (&Qvisibility
);
10910 Qwindow_id
= intern ("window-id");
10911 staticpro (&Qwindow_id
);
10912 Qouter_window_id
= intern ("outer-window-id");
10913 staticpro (&Qouter_window_id
);
10914 Qx_frame_parameter
= intern ("x-frame-parameter");
10915 staticpro (&Qx_frame_parameter
);
10916 Qx_resource_name
= intern ("x-resource-name");
10917 staticpro (&Qx_resource_name
);
10918 Quser_position
= intern ("user-position");
10919 staticpro (&Quser_position
);
10920 Quser_size
= intern ("user-size");
10921 staticpro (&Quser_size
);
10922 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10923 staticpro (&Qscroll_bar_foreground
);
10924 Qscroll_bar_background
= intern ("scroll-bar-background");
10925 staticpro (&Qscroll_bar_background
);
10926 Qscreen_gamma
= intern ("screen-gamma");
10927 staticpro (&Qscreen_gamma
);
10928 Qline_spacing
= intern ("line-spacing");
10929 staticpro (&Qline_spacing
);
10930 Qcenter
= intern ("center");
10931 staticpro (&Qcenter
);
10932 Qcompound_text
= intern ("compound-text");
10933 staticpro (&Qcompound_text
);
10934 /* This is the end of symbol initialization. */
10936 /* Text property `display' should be nonsticky by default. */
10937 Vtext_property_default_nonsticky
10938 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10941 Qlaplace
= intern ("laplace");
10942 staticpro (&Qlaplace
);
10943 Qemboss
= intern ("emboss");
10944 staticpro (&Qemboss
);
10945 Qedge_detection
= intern ("edge-detection");
10946 staticpro (&Qedge_detection
);
10947 Qheuristic
= intern ("heuristic");
10948 staticpro (&Qheuristic
);
10949 QCmatrix
= intern (":matrix");
10950 staticpro (&QCmatrix
);
10951 QCcolor_adjustment
= intern (":color-adjustment");
10952 staticpro (&QCcolor_adjustment
);
10953 QCmask
= intern (":mask");
10954 staticpro (&QCmask
);
10956 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10957 staticpro (&Qface_set_after_frame_default
);
10959 Fput (Qundefined_color
, Qerror_conditions
,
10960 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10961 Fput (Qundefined_color
, Qerror_message
,
10962 build_string ("Undefined color"));
10964 init_x_parm_symbols ();
10966 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
10967 "Non-nil means always draw a cross over disabled images.\n\
10968 Disabled images are those having an `:algorithm disabled' property.\n\
10969 A cross is always drawn on black & white displays.");
10970 cross_disabled_images
= 0;
10972 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10973 "List of directories to search for bitmap files for X.");
10974 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10976 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10977 "The shape of the pointer when over text.\n\
10978 Changing the value does not affect existing frames\n\
10979 unless you set the mouse color.");
10980 Vx_pointer_shape
= Qnil
;
10982 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10983 "The name Emacs uses to look up X resources.\n\
10984 `x-get-resource' uses this as the first component of the instance name\n\
10985 when requesting resource values.\n\
10986 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10987 was invoked, or to the value specified with the `-name' or `-rn'\n\
10988 switches, if present.\n\
10990 It may be useful to bind this variable locally around a call\n\
10991 to `x-get-resource'. See also the variable `x-resource-class'.");
10992 Vx_resource_name
= Qnil
;
10994 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10995 "The class Emacs uses to look up X resources.\n\
10996 `x-get-resource' uses this as the first component of the instance class\n\
10997 when requesting resource values.\n\
10998 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11000 Setting this variable permanently is not a reasonable thing to do,\n\
11001 but binding this variable locally around a call to `x-get-resource'\n\
11002 is a reasonable practice. See also the variable `x-resource-name'.");
11003 Vx_resource_class
= build_string (EMACS_CLASS
);
11005 #if 0 /* This doesn't really do anything. */
11006 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11007 "The shape of the pointer when not over text.\n\
11008 This variable takes effect when you create a new frame\n\
11009 or when you set the mouse color.");
11011 Vx_nontext_pointer_shape
= Qnil
;
11013 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11014 "The shape of the pointer when Emacs is busy.\n\
11015 This variable takes effect when you create a new frame\n\
11016 or when you set the mouse color.");
11017 Vx_busy_pointer_shape
= Qnil
;
11019 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11020 "Non-zero means Emacs displays a busy cursor on window systems.");
11021 display_busy_cursor_p
= 1;
11023 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11024 "*Seconds to wait before displaying a busy-cursor.\n\
11025 Value must be an integer or float.");
11026 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11028 #if 0 /* This doesn't really do anything. */
11029 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11030 "The shape of the pointer when over the mode line.\n\
11031 This variable takes effect when you create a new frame\n\
11032 or when you set the mouse color.");
11034 Vx_mode_pointer_shape
= Qnil
;
11036 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11037 &Vx_sensitive_text_pointer_shape
,
11038 "The shape of the pointer when over mouse-sensitive text.\n\
11039 This variable takes effect when you create a new frame\n\
11040 or when you set the mouse color.");
11041 Vx_sensitive_text_pointer_shape
= Qnil
;
11043 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11044 "A string indicating the foreground color of the cursor box.");
11045 Vx_cursor_fore_pixel
= Qnil
;
11047 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11048 "Non-nil if no X window manager is in use.\n\
11049 Emacs doesn't try to figure this out; this is always nil\n\
11050 unless you set it to something else.");
11051 /* We don't have any way to find this out, so set it to nil
11052 and maybe the user would like to set it to t. */
11053 Vx_no_window_manager
= Qnil
;
11055 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11056 &Vx_pixel_size_width_font_regexp
,
11057 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11059 Since Emacs gets width of a font matching with this regexp from\n\
11060 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11061 such a font. This is especially effective for such large fonts as\n\
11062 Chinese, Japanese, and Korean.");
11063 Vx_pixel_size_width_font_regexp
= Qnil
;
11065 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11066 "Time after which cached images are removed from the cache.\n\
11067 When an image has not been displayed this many seconds, remove it\n\
11068 from the image cache. Value must be an integer or nil with nil\n\
11069 meaning don't clear the cache.");
11070 Vimage_cache_eviction_delay
= make_number (30 * 60);
11072 #ifdef USE_X_TOOLKIT
11073 Fprovide (intern ("x-toolkit"));
11076 Fprovide (intern ("motif"));
11079 defsubr (&Sx_get_resource
);
11081 /* X window properties. */
11082 defsubr (&Sx_change_window_property
);
11083 defsubr (&Sx_delete_window_property
);
11084 defsubr (&Sx_window_property
);
11086 defsubr (&Sxw_display_color_p
);
11087 defsubr (&Sx_display_grayscale_p
);
11088 defsubr (&Sxw_color_defined_p
);
11089 defsubr (&Sxw_color_values
);
11090 defsubr (&Sx_server_max_request_size
);
11091 defsubr (&Sx_server_vendor
);
11092 defsubr (&Sx_server_version
);
11093 defsubr (&Sx_display_pixel_width
);
11094 defsubr (&Sx_display_pixel_height
);
11095 defsubr (&Sx_display_mm_width
);
11096 defsubr (&Sx_display_mm_height
);
11097 defsubr (&Sx_display_screens
);
11098 defsubr (&Sx_display_planes
);
11099 defsubr (&Sx_display_color_cells
);
11100 defsubr (&Sx_display_visual_class
);
11101 defsubr (&Sx_display_backing_store
);
11102 defsubr (&Sx_display_save_under
);
11103 defsubr (&Sx_parse_geometry
);
11104 defsubr (&Sx_create_frame
);
11105 defsubr (&Sx_open_connection
);
11106 defsubr (&Sx_close_connection
);
11107 defsubr (&Sx_display_list
);
11108 defsubr (&Sx_synchronize
);
11109 defsubr (&Sx_focus_frame
);
11111 /* Setting callback functions for fontset handler. */
11112 get_font_info_func
= x_get_font_info
;
11114 #if 0 /* This function pointer doesn't seem to be used anywhere.
11115 And the pointer assigned has the wrong type, anyway. */
11116 list_fonts_func
= x_list_fonts
;
11119 load_font_func
= x_load_font
;
11120 find_ccl_program_func
= x_find_ccl_program
;
11121 query_font_func
= x_query_font
;
11122 set_frame_fontset_func
= x_set_font
;
11123 check_window_system_func
= check_x
;
11126 Qxbm
= intern ("xbm");
11128 QCtype
= intern (":type");
11129 staticpro (&QCtype
);
11130 QCalgorithm
= intern (":algorithm");
11131 staticpro (&QCalgorithm
);
11132 QCheuristic_mask
= intern (":heuristic-mask");
11133 staticpro (&QCheuristic_mask
);
11134 QCcolor_symbols
= intern (":color-symbols");
11135 staticpro (&QCcolor_symbols
);
11136 QCascent
= intern (":ascent");
11137 staticpro (&QCascent
);
11138 QCmargin
= intern (":margin");
11139 staticpro (&QCmargin
);
11140 QCrelief
= intern (":relief");
11141 staticpro (&QCrelief
);
11142 Qpostscript
= intern ("postscript");
11143 staticpro (&Qpostscript
);
11144 QCloader
= intern (":loader");
11145 staticpro (&QCloader
);
11146 QCbounding_box
= intern (":bounding-box");
11147 staticpro (&QCbounding_box
);
11148 QCpt_width
= intern (":pt-width");
11149 staticpro (&QCpt_width
);
11150 QCpt_height
= intern (":pt-height");
11151 staticpro (&QCpt_height
);
11152 QCindex
= intern (":index");
11153 staticpro (&QCindex
);
11154 Qpbm
= intern ("pbm");
11158 Qxpm
= intern ("xpm");
11163 Qjpeg
= intern ("jpeg");
11164 staticpro (&Qjpeg
);
11168 Qtiff
= intern ("tiff");
11169 staticpro (&Qtiff
);
11173 Qgif
= intern ("gif");
11178 Qpng
= intern ("png");
11182 defsubr (&Sclear_image_cache
);
11183 defsubr (&Simage_size
);
11184 defsubr (&Simage_mask_p
);
11186 busy_cursor_atimer
= NULL
;
11187 busy_cursor_shown_p
= 0;
11189 defsubr (&Sx_show_tip
);
11190 defsubr (&Sx_hide_tip
);
11191 staticpro (&tip_timer
);
11195 defsubr (&Sx_file_dialog
);
11203 image_types
= NULL
;
11204 Vimage_types
= Qnil
;
11206 define_image_type (&xbm_type
);
11207 define_image_type (&gs_type
);
11208 define_image_type (&pbm_type
);
11211 define_image_type (&xpm_type
);
11215 define_image_type (&jpeg_type
);
11219 define_image_type (&tiff_type
);
11223 define_image_type (&gif_type
);
11227 define_image_type (&png_type
);
11231 #endif /* HAVE_X_WINDOWS */