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_create_im
P_ ((struct frame
*));
748 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
761 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
766 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
774 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
776 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
781 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
782 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
785 static struct x_frame_parm_table x_frame_parms
[] =
787 "auto-raise", x_set_autoraise
,
788 "auto-lower", x_set_autolower
,
789 "background-color", x_set_background_color
,
790 "border-color", x_set_border_color
,
791 "border-width", x_set_border_width
,
792 "cursor-color", x_set_cursor_color
,
793 "cursor-type", x_set_cursor_type
,
795 "foreground-color", x_set_foreground_color
,
796 "icon-name", x_set_icon_name
,
797 "icon-type", x_set_icon_type
,
798 "internal-border-width", x_set_internal_border_width
,
799 "menu-bar-lines", x_set_menu_bar_lines
,
800 "mouse-color", x_set_mouse_color
,
801 "name", x_explicitly_set_name
,
802 "scroll-bar-width", x_set_scroll_bar_width
,
803 "title", x_set_title
,
804 "unsplittable", x_set_unsplittable
,
805 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
806 "visibility", x_set_visibility
,
807 "tool-bar-lines", x_set_tool_bar_lines
,
808 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
809 "scroll-bar-background", x_set_scroll_bar_background
,
810 "screen-gamma", x_set_screen_gamma
,
811 "line-spacing", x_set_line_spacing
814 /* Attach the `x-frame-parameter' properties to
815 the Lisp symbol names of parameters relevant to X. */
818 init_x_parm_symbols ()
822 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
823 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
827 /* Change the parameters of frame F as specified by ALIST.
828 If a parameter is not specially recognized, do nothing special;
829 otherwise call the `x_set_...' function for that parameter.
830 Except for certain geometry properties, always call store_frame_param
831 to store the new value in the parameter alist. */
834 x_set_frame_parameters (f
, alist
)
840 /* If both of these parameters are present, it's more efficient to
841 set them both at once. So we wait until we've looked at the
842 entire list before we set them. */
846 Lisp_Object left
, top
;
848 /* Same with these. */
849 Lisp_Object icon_left
, icon_top
;
851 /* Record in these vectors all the parms specified. */
855 int left_no_change
= 0, top_no_change
= 0;
856 int icon_left_no_change
= 0, icon_top_no_change
= 0;
858 struct gcpro gcpro1
, gcpro2
;
861 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
864 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
865 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
867 /* Extract parm names and values into those vectors. */
870 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
875 parms
[i
] = Fcar (elt
);
876 values
[i
] = Fcdr (elt
);
879 /* TAIL and ALIST are not used again below here. */
882 GCPRO2 (*parms
, *values
);
886 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
887 because their values appear in VALUES and strings are not valid. */
888 top
= left
= Qunbound
;
889 icon_left
= icon_top
= Qunbound
;
891 /* Provide default values for HEIGHT and WIDTH. */
892 if (FRAME_NEW_WIDTH (f
))
893 width
= FRAME_NEW_WIDTH (f
);
895 width
= FRAME_WIDTH (f
);
897 if (FRAME_NEW_HEIGHT (f
))
898 height
= FRAME_NEW_HEIGHT (f
);
900 height
= FRAME_HEIGHT (f
);
902 /* Process foreground_color and background_color before anything else.
903 They are independent of other properties, but other properties (e.g.,
904 cursor_color) are dependent upon them. */
905 for (p
= 0; p
< i
; p
++)
907 Lisp_Object prop
, val
;
911 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
913 register Lisp_Object param_index
, old_value
;
915 param_index
= Fget (prop
, Qx_frame_parameter
);
916 old_value
= get_frame_param (f
, prop
);
917 store_frame_param (f
, prop
, val
);
918 if (NATNUMP (param_index
)
919 && (XFASTINT (param_index
)
920 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
921 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
925 /* Now process them in reverse of specified order. */
926 for (i
--; i
>= 0; i
--)
928 Lisp_Object prop
, val
;
933 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
934 width
= XFASTINT (val
);
935 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
936 height
= XFASTINT (val
);
937 else if (EQ (prop
, Qtop
))
939 else if (EQ (prop
, Qleft
))
941 else if (EQ (prop
, Qicon_top
))
943 else if (EQ (prop
, Qicon_left
))
945 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
946 /* Processed above. */
950 register Lisp_Object param_index
, old_value
;
952 param_index
= Fget (prop
, Qx_frame_parameter
);
953 old_value
= get_frame_param (f
, prop
);
954 store_frame_param (f
, prop
, val
);
955 if (NATNUMP (param_index
)
956 && (XFASTINT (param_index
)
957 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
958 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
962 /* Don't die if just one of these was set. */
963 if (EQ (left
, Qunbound
))
966 if (f
->output_data
.x
->left_pos
< 0)
967 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
969 XSETINT (left
, f
->output_data
.x
->left_pos
);
971 if (EQ (top
, Qunbound
))
974 if (f
->output_data
.x
->top_pos
< 0)
975 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
977 XSETINT (top
, f
->output_data
.x
->top_pos
);
980 /* If one of the icon positions was not set, preserve or default it. */
981 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
983 icon_left_no_change
= 1;
984 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
985 if (NILP (icon_left
))
986 XSETINT (icon_left
, 0);
988 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
990 icon_top_no_change
= 1;
991 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
993 XSETINT (icon_top
, 0);
996 /* Don't set these parameters unless they've been explicitly
997 specified. The window might be mapped or resized while we're in
998 this function, and we don't want to override that unless the lisp
999 code has asked for it.
1001 Don't set these parameters unless they actually differ from the
1002 window's current parameters; the window may not actually exist
1007 check_frame_size (f
, &height
, &width
);
1009 XSETFRAME (frame
, f
);
1011 if (width
!= FRAME_WIDTH (f
)
1012 || height
!= FRAME_HEIGHT (f
)
1013 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1014 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1016 if ((!NILP (left
) || !NILP (top
))
1017 && ! (left_no_change
&& top_no_change
)
1018 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1019 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1024 /* Record the signs. */
1025 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1026 if (EQ (left
, Qminus
))
1027 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1028 else if (INTEGERP (left
))
1030 leftpos
= XINT (left
);
1032 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1034 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1035 && CONSP (XCDR (left
))
1036 && INTEGERP (XCAR (XCDR (left
))))
1038 leftpos
= - XINT (XCAR (XCDR (left
)));
1039 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1041 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1042 && CONSP (XCDR (left
))
1043 && INTEGERP (XCAR (XCDR (left
))))
1045 leftpos
= XINT (XCAR (XCDR (left
)));
1048 if (EQ (top
, Qminus
))
1049 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1050 else if (INTEGERP (top
))
1052 toppos
= XINT (top
);
1054 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1056 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1057 && CONSP (XCDR (top
))
1058 && INTEGERP (XCAR (XCDR (top
))))
1060 toppos
= - XINT (XCAR (XCDR (top
)));
1061 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1063 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1064 && CONSP (XCDR (top
))
1065 && INTEGERP (XCAR (XCDR (top
))))
1067 toppos
= XINT (XCAR (XCDR (top
)));
1071 /* Store the numeric value of the position. */
1072 f
->output_data
.x
->top_pos
= toppos
;
1073 f
->output_data
.x
->left_pos
= leftpos
;
1075 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1077 /* Actually set that position, and convert to absolute. */
1078 x_set_offset (f
, leftpos
, toppos
, -1);
1081 if ((!NILP (icon_left
) || !NILP (icon_top
))
1082 && ! (icon_left_no_change
&& icon_top_no_change
))
1083 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1089 /* Store the screen positions of frame F into XPTR and YPTR.
1090 These are the positions of the containing window manager window,
1091 not Emacs's own window. */
1094 x_real_positions (f
, xptr
, yptr
)
1101 /* This is pretty gross, but seems to be the easiest way out of
1102 the problem that arises when restarting window-managers. */
1104 #ifdef USE_X_TOOLKIT
1105 Window outer
= (f
->output_data
.x
->widget
1106 ? XtWindow (f
->output_data
.x
->widget
)
1107 : FRAME_X_WINDOW (f
));
1109 Window outer
= f
->output_data
.x
->window_desc
;
1111 Window tmp_root_window
;
1112 Window
*tmp_children
;
1113 unsigned int tmp_nchildren
;
1117 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1118 Window outer_window
;
1120 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1121 &f
->output_data
.x
->parent_desc
,
1122 &tmp_children
, &tmp_nchildren
);
1123 XFree ((char *) tmp_children
);
1127 /* Find the position of the outside upper-left corner of
1128 the inner window, with respect to the outer window. */
1129 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1130 outer_window
= f
->output_data
.x
->parent_desc
;
1132 outer_window
= outer
;
1134 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1136 /* From-window, to-window. */
1138 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1140 /* From-position, to-position. */
1141 0, 0, &win_x
, &win_y
,
1146 /* It is possible for the window returned by the XQueryNotify
1147 to become invalid by the time we call XTranslateCoordinates.
1148 That can happen when you restart some window managers.
1149 If so, we get an error in XTranslateCoordinates.
1150 Detect that and try the whole thing over. */
1151 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1153 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1157 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1164 /* Insert a description of internally-recorded parameters of frame X
1165 into the parameter alist *ALISTPTR that is to be given to the user.
1166 Only parameters that are specific to the X window system
1167 and whose values are not correctly recorded in the frame's
1168 param_alist need to be considered here. */
1171 x_report_frame_params (f
, alistptr
)
1173 Lisp_Object
*alistptr
;
1178 /* Represent negative positions (off the top or left screen edge)
1179 in a way that Fmodify_frame_parameters will understand correctly. */
1180 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1181 if (f
->output_data
.x
->left_pos
>= 0)
1182 store_in_alist (alistptr
, Qleft
, tem
);
1184 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1186 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1187 if (f
->output_data
.x
->top_pos
>= 0)
1188 store_in_alist (alistptr
, Qtop
, tem
);
1190 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1192 store_in_alist (alistptr
, Qborder_width
,
1193 make_number (f
->output_data
.x
->border_width
));
1194 store_in_alist (alistptr
, Qinternal_border_width
,
1195 make_number (f
->output_data
.x
->internal_border_width
));
1196 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1197 store_in_alist (alistptr
, Qwindow_id
,
1198 build_string (buf
));
1199 #ifdef USE_X_TOOLKIT
1200 /* Tooltip frame may not have this widget. */
1201 if (f
->output_data
.x
->widget
)
1203 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1204 store_in_alist (alistptr
, Qouter_window_id
,
1205 build_string (buf
));
1206 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1207 FRAME_SAMPLE_VISIBILITY (f
);
1208 store_in_alist (alistptr
, Qvisibility
,
1209 (FRAME_VISIBLE_P (f
) ? Qt
1210 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1211 store_in_alist (alistptr
, Qdisplay
,
1212 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1214 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1217 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1218 store_in_alist (alistptr
, Qparent_id
, tem
);
1223 /* Gamma-correct COLOR on frame F. */
1226 gamma_correct (f
, color
)
1232 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1233 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1234 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1239 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1240 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1241 allocate the color. Value is zero if COLOR_NAME is invalid, or
1242 no color could be allocated. */
1245 x_defined_color (f
, color_name
, color
, alloc_p
)
1252 Display
*dpy
= FRAME_X_DISPLAY (f
);
1253 Colormap cmap
= FRAME_X_COLORMAP (f
);
1256 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1257 if (success_p
&& alloc_p
)
1258 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1265 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1266 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1267 Signal an error if color can't be allocated. */
1270 x_decode_color (f
, color_name
, mono_color
)
1272 Lisp_Object color_name
;
1277 CHECK_STRING (color_name
, 0);
1279 #if 0 /* Don't do this. It's wrong when we're not using the default
1280 colormap, it makes freeing difficult, and it's probably not
1281 an important optimization. */
1282 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1283 return BLACK_PIX_DEFAULT (f
);
1284 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1285 return WHITE_PIX_DEFAULT (f
);
1288 /* Return MONO_COLOR for monochrome frames. */
1289 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1292 /* x_defined_color is responsible for coping with failures
1293 by looking for a near-miss. */
1294 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1297 return Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1298 Fcons (color_name
, Qnil
)));
1303 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1304 the previous value of that parameter, NEW_VALUE is the new value. */
1307 x_set_line_spacing (f
, new_value
, old_value
)
1309 Lisp_Object new_value
, old_value
;
1311 if (NILP (new_value
))
1312 f
->extra_line_spacing
= 0;
1313 else if (NATNUMP (new_value
))
1314 f
->extra_line_spacing
= XFASTINT (new_value
);
1316 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1317 Fcons (new_value
, Qnil
)));
1318 if (FRAME_VISIBLE_P (f
))
1323 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1324 the previous value of that parameter, NEW_VALUE is the new value. */
1327 x_set_screen_gamma (f
, new_value
, old_value
)
1329 Lisp_Object new_value
, old_value
;
1331 if (NILP (new_value
))
1333 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1334 /* The value 0.4545 is the normal viewing gamma. */
1335 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1337 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1338 Fcons (new_value
, Qnil
)));
1340 clear_face_cache (0);
1344 /* Functions called only from `x_set_frame_param'
1345 to set individual parameters.
1347 If FRAME_X_WINDOW (f) is 0,
1348 the frame is being created and its X-window does not exist yet.
1349 In that case, just record the parameter's new value
1350 in the standard place; do not attempt to change the window. */
1353 x_set_foreground_color (f
, arg
, oldval
)
1355 Lisp_Object arg
, oldval
;
1358 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1360 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1361 f
->output_data
.x
->foreground_pixel
= pixel
;
1363 if (FRAME_X_WINDOW (f
) != 0)
1366 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1367 f
->output_data
.x
->foreground_pixel
);
1368 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1369 f
->output_data
.x
->foreground_pixel
);
1371 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1372 if (FRAME_VISIBLE_P (f
))
1378 x_set_background_color (f
, arg
, oldval
)
1380 Lisp_Object arg
, oldval
;
1383 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1385 unload_color (f
, f
->output_data
.x
->background_pixel
);
1386 f
->output_data
.x
->background_pixel
= pixel
;
1388 if (FRAME_X_WINDOW (f
) != 0)
1391 /* The main frame area. */
1392 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1393 f
->output_data
.x
->background_pixel
);
1394 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1395 f
->output_data
.x
->background_pixel
);
1396 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1397 f
->output_data
.x
->background_pixel
);
1398 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1399 f
->output_data
.x
->background_pixel
);
1402 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1403 bar
= XSCROLL_BAR (bar
)->next
)
1404 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1405 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1406 f
->output_data
.x
->background_pixel
);
1410 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1412 if (FRAME_VISIBLE_P (f
))
1418 x_set_mouse_color (f
, arg
, oldval
)
1420 Lisp_Object arg
, oldval
;
1422 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1425 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1426 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1428 /* Don't let pointers be invisible. */
1429 if (mask_color
== pixel
1430 && mask_color
== f
->output_data
.x
->background_pixel
)
1431 pixel
= f
->output_data
.x
->foreground_pixel
;
1433 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1434 f
->output_data
.x
->mouse_pixel
= pixel
;
1438 /* It's not okay to crash if the user selects a screwy cursor. */
1439 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1441 if (!EQ (Qnil
, Vx_pointer_shape
))
1443 CHECK_NUMBER (Vx_pointer_shape
, 0);
1444 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1447 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1448 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1450 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1452 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1453 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1454 XINT (Vx_nontext_pointer_shape
));
1457 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1458 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1460 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1462 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1463 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1464 XINT (Vx_busy_pointer_shape
));
1467 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1468 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1470 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1471 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1473 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1474 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1475 XINT (Vx_mode_pointer_shape
));
1478 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1479 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1481 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1483 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1485 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1486 XINT (Vx_sensitive_text_pointer_shape
));
1489 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1491 /* Check and report errors with the above calls. */
1492 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1493 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1496 XColor fore_color
, back_color
;
1498 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1499 back_color
.pixel
= mask_color
;
1500 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1502 XQueryColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
1504 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1505 &fore_color
, &back_color
);
1506 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1507 &fore_color
, &back_color
);
1508 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1509 &fore_color
, &back_color
);
1510 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1511 &fore_color
, &back_color
);
1512 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1513 &fore_color
, &back_color
);
1516 if (FRAME_X_WINDOW (f
) != 0)
1517 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1519 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1520 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1521 f
->output_data
.x
->text_cursor
= cursor
;
1523 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1524 && f
->output_data
.x
->nontext_cursor
!= 0)
1525 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1526 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1528 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1529 && f
->output_data
.x
->busy_cursor
!= 0)
1530 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1531 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1533 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1534 && f
->output_data
.x
->modeline_cursor
!= 0)
1535 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1536 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1538 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1539 && f
->output_data
.x
->cross_cursor
!= 0)
1540 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1541 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1543 XFlush (FRAME_X_DISPLAY (f
));
1546 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1550 x_set_cursor_color (f
, arg
, oldval
)
1552 Lisp_Object arg
, oldval
;
1554 unsigned long fore_pixel
, pixel
;
1555 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1557 if (!NILP (Vx_cursor_fore_pixel
))
1559 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1560 WHITE_PIX_DEFAULT (f
));
1561 fore_pixel_allocated_p
= 1;
1564 fore_pixel
= f
->output_data
.x
->background_pixel
;
1566 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1567 pixel_allocated_p
= 1;
1569 /* Make sure that the cursor color differs from the background color. */
1570 if (pixel
== f
->output_data
.x
->background_pixel
)
1572 if (pixel_allocated_p
)
1574 x_free_colors (f
, &pixel
, 1);
1575 pixel_allocated_p
= 0;
1578 pixel
= f
->output_data
.x
->mouse_pixel
;
1579 if (pixel
== fore_pixel
)
1581 if (fore_pixel_allocated_p
)
1583 x_free_colors (f
, &fore_pixel
, 1);
1584 fore_pixel_allocated_p
= 0;
1586 fore_pixel
= f
->output_data
.x
->background_pixel
;
1590 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1591 if (!fore_pixel_allocated_p
)
1592 fore_pixel
= x_copy_color (f
, fore_pixel
);
1593 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1595 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1596 if (!pixel_allocated_p
)
1597 pixel
= x_copy_color (f
, pixel
);
1598 f
->output_data
.x
->cursor_pixel
= pixel
;
1600 if (FRAME_X_WINDOW (f
) != 0)
1603 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1604 f
->output_data
.x
->cursor_pixel
);
1605 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1609 if (FRAME_VISIBLE_P (f
))
1611 x_update_cursor (f
, 0);
1612 x_update_cursor (f
, 1);
1616 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1619 /* Set the border-color of frame F to value described by ARG.
1620 ARG can be a string naming a color.
1621 The border-color is used for the border that is drawn by the X server.
1622 Note that this does not fully take effect if done before
1623 F has an x-window; it must be redone when the window is created.
1625 Note: this is done in two routines because of the way X10 works.
1627 Note: under X11, this is normally the province of the window manager,
1628 and so emacs' border colors may be overridden. */
1631 x_set_border_color (f
, arg
, oldval
)
1633 Lisp_Object arg
, oldval
;
1637 CHECK_STRING (arg
, 0);
1638 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1639 x_set_border_pixel (f
, pix
);
1640 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1643 /* Set the border-color of frame F to pixel value PIX.
1644 Note that this does not fully take effect if done before
1645 F has an x-window. */
1648 x_set_border_pixel (f
, pix
)
1652 unload_color (f
, f
->output_data
.x
->border_pixel
);
1653 f
->output_data
.x
->border_pixel
= pix
;
1655 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1658 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1659 (unsigned long)pix
);
1662 if (FRAME_VISIBLE_P (f
))
1668 /* Value is the internal representation of the specified cursor type
1669 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1670 of the bar cursor. */
1672 enum text_cursor_kinds
1673 x_specified_cursor_type (arg
, width
)
1677 enum text_cursor_kinds type
;
1684 else if (CONSP (arg
)
1685 && EQ (XCAR (arg
), Qbar
)
1686 && INTEGERP (XCDR (arg
))
1687 && XINT (XCDR (arg
)) >= 0)
1690 *width
= XINT (XCDR (arg
));
1692 else if (NILP (arg
))
1695 /* Treat anything unknown as "box cursor".
1696 It was bad to signal an error; people have trouble fixing
1697 .Xdefaults with Emacs, when it has something bad in it. */
1698 type
= FILLED_BOX_CURSOR
;
1704 x_set_cursor_type (f
, arg
, oldval
)
1706 Lisp_Object arg
, oldval
;
1710 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1711 f
->output_data
.x
->cursor_width
= width
;
1713 /* Make sure the cursor gets redrawn. This is overkill, but how
1714 often do people change cursor types? */
1715 update_mode_lines
++;
1719 x_set_icon_type (f
, arg
, oldval
)
1721 Lisp_Object arg
, oldval
;
1727 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1730 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1735 result
= x_text_icon (f
,
1736 (char *) XSTRING ((!NILP (f
->icon_name
)
1740 result
= x_bitmap_icon (f
, arg
);
1745 error ("No icon window available");
1748 XFlush (FRAME_X_DISPLAY (f
));
1752 /* Return non-nil if frame F wants a bitmap icon. */
1760 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1768 x_set_icon_name (f
, arg
, oldval
)
1770 Lisp_Object arg
, oldval
;
1776 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1779 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1784 if (f
->output_data
.x
->icon_bitmap
!= 0)
1789 result
= x_text_icon (f
,
1790 (char *) XSTRING ((!NILP (f
->icon_name
)
1799 error ("No icon window available");
1802 XFlush (FRAME_X_DISPLAY (f
));
1807 x_set_font (f
, arg
, oldval
)
1809 Lisp_Object arg
, oldval
;
1812 Lisp_Object fontset_name
;
1815 CHECK_STRING (arg
, 1);
1817 fontset_name
= Fquery_fontset (arg
, Qnil
);
1820 result
= (STRINGP (fontset_name
)
1821 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1822 : x_new_font (f
, XSTRING (arg
)->data
));
1825 if (EQ (result
, Qnil
))
1826 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1827 else if (EQ (result
, Qt
))
1828 error ("The characters of the given font have varying widths");
1829 else if (STRINGP (result
))
1831 store_frame_param (f
, Qfont
, result
);
1832 recompute_basic_faces (f
);
1837 do_pending_window_change (0);
1839 /* Don't call `face-set-after-frame-default' when faces haven't been
1840 initialized yet. This is the case when called from
1841 Fx_create_frame. In that case, the X widget or window doesn't
1842 exist either, and we can end up in x_report_frame_params with a
1843 null widget which gives a segfault. */
1844 if (FRAME_FACE_CACHE (f
))
1846 XSETFRAME (frame
, f
);
1847 call1 (Qface_set_after_frame_default
, frame
);
1852 x_set_border_width (f
, arg
, oldval
)
1854 Lisp_Object arg
, oldval
;
1856 CHECK_NUMBER (arg
, 0);
1858 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1861 if (FRAME_X_WINDOW (f
) != 0)
1862 error ("Cannot change the border width of a window");
1864 f
->output_data
.x
->border_width
= XINT (arg
);
1868 x_set_internal_border_width (f
, arg
, oldval
)
1870 Lisp_Object arg
, oldval
;
1872 int old
= f
->output_data
.x
->internal_border_width
;
1874 CHECK_NUMBER (arg
, 0);
1875 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1876 if (f
->output_data
.x
->internal_border_width
< 0)
1877 f
->output_data
.x
->internal_border_width
= 0;
1879 #ifdef USE_X_TOOLKIT
1880 if (f
->output_data
.x
->edit_widget
)
1881 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1884 if (f
->output_data
.x
->internal_border_width
== old
)
1887 if (FRAME_X_WINDOW (f
) != 0)
1889 x_set_window_size (f
, 0, f
->width
, f
->height
);
1890 SET_FRAME_GARBAGED (f
);
1891 do_pending_window_change (0);
1896 x_set_visibility (f
, value
, oldval
)
1898 Lisp_Object value
, oldval
;
1901 XSETFRAME (frame
, f
);
1904 Fmake_frame_invisible (frame
, Qt
);
1905 else if (EQ (value
, Qicon
))
1906 Ficonify_frame (frame
);
1908 Fmake_frame_visible (frame
);
1912 x_set_menu_bar_lines_1 (window
, n
)
1916 struct window
*w
= XWINDOW (window
);
1918 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1919 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1921 if (INTEGERP (w
->orig_top
))
1922 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1923 if (INTEGERP (w
->orig_height
))
1924 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1926 /* Handle just the top child in a vertical split. */
1927 if (!NILP (w
->vchild
))
1928 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1930 /* Adjust all children in a horizontal split. */
1931 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1933 w
= XWINDOW (window
);
1934 x_set_menu_bar_lines_1 (window
, n
);
1939 x_set_menu_bar_lines (f
, value
, oldval
)
1941 Lisp_Object value
, oldval
;
1944 #ifndef USE_X_TOOLKIT
1945 int olines
= FRAME_MENU_BAR_LINES (f
);
1948 /* Right now, menu bars don't work properly in minibuf-only frames;
1949 most of the commands try to apply themselves to the minibuffer
1950 frame itself, and get an error because you can't switch buffers
1951 in or split the minibuffer window. */
1952 if (FRAME_MINIBUF_ONLY_P (f
))
1955 if (INTEGERP (value
))
1956 nlines
= XINT (value
);
1960 /* Make sure we redisplay all windows in this frame. */
1961 windows_or_buffers_changed
++;
1963 #ifdef USE_X_TOOLKIT
1964 FRAME_MENU_BAR_LINES (f
) = 0;
1967 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1968 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1969 /* Make sure next redisplay shows the menu bar. */
1970 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1974 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1975 free_frame_menubar (f
);
1976 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1978 f
->output_data
.x
->menubar_widget
= 0;
1980 #else /* not USE_X_TOOLKIT */
1981 FRAME_MENU_BAR_LINES (f
) = nlines
;
1982 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1983 #endif /* not USE_X_TOOLKIT */
1988 /* Set the number of lines used for the tool bar of frame F to VALUE.
1989 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1990 is the old number of tool bar lines. This function changes the
1991 height of all windows on frame F to match the new tool bar height.
1992 The frame's height doesn't change. */
1995 x_set_tool_bar_lines (f
, value
, oldval
)
1997 Lisp_Object value
, oldval
;
2001 /* Use VALUE only if an integer >= 0. */
2002 if (INTEGERP (value
) && XINT (value
) >= 0)
2003 nlines
= XFASTINT (value
);
2007 /* Make sure we redisplay all windows in this frame. */
2008 ++windows_or_buffers_changed
;
2010 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2011 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2012 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2017 /* Set the foreground color for scroll bars on frame F to VALUE.
2018 VALUE should be a string, a color name. If it isn't a string or
2019 isn't a valid color name, do nothing. OLDVAL is the old value of
2020 the frame parameter. */
2023 x_set_scroll_bar_foreground (f
, value
, oldval
)
2025 Lisp_Object value
, oldval
;
2027 unsigned long pixel
;
2029 if (STRINGP (value
))
2030 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2034 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2035 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2037 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2038 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2040 /* Remove all scroll bars because they have wrong colors. */
2041 if (condemn_scroll_bars_hook
)
2042 (*condemn_scroll_bars_hook
) (f
);
2043 if (judge_scroll_bars_hook
)
2044 (*judge_scroll_bars_hook
) (f
);
2046 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2052 /* Set the background color for scroll bars on frame F to VALUE VALUE
2053 should be a string, a color name. If it isn't a string or isn't a
2054 valid color name, do nothing. OLDVAL is the old value of the frame
2058 x_set_scroll_bar_background (f
, value
, oldval
)
2060 Lisp_Object value
, oldval
;
2062 unsigned long pixel
;
2064 if (STRINGP (value
))
2065 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2069 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2070 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2072 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2073 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2075 /* Remove all scroll bars because they have wrong colors. */
2076 if (condemn_scroll_bars_hook
)
2077 (*condemn_scroll_bars_hook
) (f
);
2078 if (judge_scroll_bars_hook
)
2079 (*judge_scroll_bars_hook
) (f
);
2081 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2087 /* Encode Lisp string STRING as a text in a format appropriate for
2088 XICCC (X Inter Client Communication Conventions).
2090 If STRING contains only ASCII characters, do no conversion and
2091 return the string data of STRING. Otherwise, encode the text by
2092 CODING_SYSTEM, and return a newly allocated memory area which
2093 should be freed by `xfree' by a caller.
2095 Store the byte length of resulting text in *TEXT_BYTES.
2097 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2098 which means that the `encoding' of the result can be `STRING'.
2099 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2100 the result should be `COMPOUND_TEXT'. */
2103 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2104 Lisp_Object string
, coding_system
;
2105 int *text_bytes
, *stringp
;
2107 unsigned char *str
= XSTRING (string
)->data
;
2108 int chars
= XSTRING (string
)->size
;
2109 int bytes
= STRING_BYTES (XSTRING (string
));
2113 struct coding_system coding
;
2115 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2116 if (charset_info
== 0)
2118 /* No multibyte character in OBJ. We need not encode it. */
2119 *text_bytes
= bytes
;
2124 setup_coding_system (coding_system
, &coding
);
2125 coding
.src_multibyte
= 1;
2126 coding
.dst_multibyte
= 0;
2127 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2128 if (coding
.type
== coding_type_iso2022
)
2129 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2130 bufsize
= encoding_buffer_size (&coding
, bytes
);
2131 buf
= (unsigned char *) xmalloc (bufsize
);
2132 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2133 *text_bytes
= coding
.produced
;
2134 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2139 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2142 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2143 name; if NAME is a string, set F's name to NAME and set
2144 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2146 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2147 suggesting a new name, which lisp code should override; if
2148 F->explicit_name is set, ignore the new name; otherwise, set it. */
2151 x_set_name (f
, name
, explicit)
2156 /* Make sure that requests from lisp code override requests from
2157 Emacs redisplay code. */
2160 /* If we're switching from explicit to implicit, we had better
2161 update the mode lines and thereby update the title. */
2162 if (f
->explicit_name
&& NILP (name
))
2163 update_mode_lines
= 1;
2165 f
->explicit_name
= ! NILP (name
);
2167 else if (f
->explicit_name
)
2170 /* If NAME is nil, set the name to the x_id_name. */
2173 /* Check for no change needed in this very common case
2174 before we do any consing. */
2175 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2176 XSTRING (f
->name
)->data
))
2178 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2181 CHECK_STRING (name
, 0);
2183 /* Don't change the name if it's already NAME. */
2184 if (! NILP (Fstring_equal (name
, f
->name
)))
2189 /* For setting the frame title, the title parameter should override
2190 the name parameter. */
2191 if (! NILP (f
->title
))
2194 if (FRAME_X_WINDOW (f
))
2199 XTextProperty text
, icon
;
2201 Lisp_Object coding_system
;
2203 coding_system
= Vlocale_coding_system
;
2204 if (NILP (coding_system
))
2205 coding_system
= Qcompound_text
;
2206 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2207 text
.encoding
= (stringp
? XA_STRING
2208 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2210 text
.nitems
= bytes
;
2212 if (NILP (f
->icon_name
))
2218 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2220 icon
.encoding
= (stringp
? XA_STRING
2221 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2223 icon
.nitems
= bytes
;
2225 #ifdef USE_X_TOOLKIT
2226 XSetWMName (FRAME_X_DISPLAY (f
),
2227 XtWindow (f
->output_data
.x
->widget
), &text
);
2228 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2230 #else /* not USE_X_TOOLKIT */
2231 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2232 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2233 #endif /* not USE_X_TOOLKIT */
2234 if (!NILP (f
->icon_name
)
2235 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2237 if (text
.value
!= XSTRING (name
)->data
)
2240 #else /* not HAVE_X11R4 */
2241 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2242 XSTRING (name
)->data
);
2243 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2244 XSTRING (name
)->data
);
2245 #endif /* not HAVE_X11R4 */
2250 /* This function should be called when the user's lisp code has
2251 specified a name for the frame; the name will override any set by the
2254 x_explicitly_set_name (f
, arg
, oldval
)
2256 Lisp_Object arg
, oldval
;
2258 x_set_name (f
, arg
, 1);
2261 /* This function should be called by Emacs redisplay code to set the
2262 name; names set this way will never override names set by the user's
2265 x_implicitly_set_name (f
, arg
, oldval
)
2267 Lisp_Object arg
, oldval
;
2269 x_set_name (f
, arg
, 0);
2272 /* Change the title of frame F to NAME.
2273 If NAME is nil, use the frame name as the title.
2275 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2276 name; if NAME is a string, set F's name to NAME and set
2277 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2279 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2280 suggesting a new name, which lisp code should override; if
2281 F->explicit_name is set, ignore the new name; otherwise, set it. */
2284 x_set_title (f
, name
, old_name
)
2286 Lisp_Object name
, old_name
;
2288 /* Don't change the title if it's already NAME. */
2289 if (EQ (name
, f
->title
))
2292 update_mode_lines
= 1;
2299 CHECK_STRING (name
, 0);
2301 if (FRAME_X_WINDOW (f
))
2306 XTextProperty text
, icon
;
2308 Lisp_Object coding_system
;
2310 coding_system
= Vlocale_coding_system
;
2311 if (NILP (coding_system
))
2312 coding_system
= Qcompound_text
;
2313 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2314 text
.encoding
= (stringp
? XA_STRING
2315 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2317 text
.nitems
= bytes
;
2319 if (NILP (f
->icon_name
))
2325 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2327 icon
.encoding
= (stringp
? XA_STRING
2328 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2330 icon
.nitems
= bytes
;
2332 #ifdef USE_X_TOOLKIT
2333 XSetWMName (FRAME_X_DISPLAY (f
),
2334 XtWindow (f
->output_data
.x
->widget
), &text
);
2335 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2337 #else /* not USE_X_TOOLKIT */
2338 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2339 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2340 #endif /* not USE_X_TOOLKIT */
2341 if (!NILP (f
->icon_name
)
2342 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2344 if (text
.value
!= XSTRING (name
)->data
)
2347 #else /* not HAVE_X11R4 */
2348 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2349 XSTRING (name
)->data
);
2350 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2351 XSTRING (name
)->data
);
2352 #endif /* not HAVE_X11R4 */
2358 x_set_autoraise (f
, arg
, oldval
)
2360 Lisp_Object arg
, oldval
;
2362 f
->auto_raise
= !EQ (Qnil
, arg
);
2366 x_set_autolower (f
, arg
, oldval
)
2368 Lisp_Object arg
, oldval
;
2370 f
->auto_lower
= !EQ (Qnil
, arg
);
2374 x_set_unsplittable (f
, arg
, oldval
)
2376 Lisp_Object arg
, oldval
;
2378 f
->no_split
= !NILP (arg
);
2382 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2384 Lisp_Object arg
, oldval
;
2386 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2387 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2388 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2389 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2391 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2393 ? vertical_scroll_bar_none
2395 ? vertical_scroll_bar_right
2396 : vertical_scroll_bar_left
);
2398 /* We set this parameter before creating the X window for the
2399 frame, so we can get the geometry right from the start.
2400 However, if the window hasn't been created yet, we shouldn't
2401 call x_set_window_size. */
2402 if (FRAME_X_WINDOW (f
))
2403 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2404 do_pending_window_change (0);
2409 x_set_scroll_bar_width (f
, arg
, oldval
)
2411 Lisp_Object arg
, oldval
;
2413 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2417 #ifdef USE_TOOLKIT_SCROLL_BARS
2418 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2419 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2420 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2421 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2423 /* Make the actual width at least 14 pixels and a multiple of a
2425 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2427 /* Use all of that space (aside from required margins) for the
2429 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2432 if (FRAME_X_WINDOW (f
))
2433 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2434 do_pending_window_change (0);
2436 else if (INTEGERP (arg
) && XINT (arg
) > 0
2437 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2439 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2440 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2442 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2443 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2444 if (FRAME_X_WINDOW (f
))
2445 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2448 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2449 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2450 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2455 /* Subroutines of creating an X frame. */
2457 /* Make sure that Vx_resource_name is set to a reasonable value.
2458 Fix it up, or set it to `emacs' if it is too hopeless. */
2461 validate_x_resource_name ()
2464 /* Number of valid characters in the resource name. */
2466 /* Number of invalid characters in the resource name. */
2471 if (!STRINGP (Vx_resource_class
))
2472 Vx_resource_class
= build_string (EMACS_CLASS
);
2474 if (STRINGP (Vx_resource_name
))
2476 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2479 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2481 /* Only letters, digits, - and _ are valid in resource names.
2482 Count the valid characters and count the invalid ones. */
2483 for (i
= 0; i
< len
; i
++)
2486 if (! ((c
>= 'a' && c
<= 'z')
2487 || (c
>= 'A' && c
<= 'Z')
2488 || (c
>= '0' && c
<= '9')
2489 || c
== '-' || c
== '_'))
2496 /* Not a string => completely invalid. */
2497 bad_count
= 5, good_count
= 0;
2499 /* If name is valid already, return. */
2503 /* If name is entirely invalid, or nearly so, use `emacs'. */
2505 || (good_count
== 1 && bad_count
> 0))
2507 Vx_resource_name
= build_string ("emacs");
2511 /* Name is partly valid. Copy it and replace the invalid characters
2512 with underscores. */
2514 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2516 for (i
= 0; i
< len
; i
++)
2518 int c
= XSTRING (new)->data
[i
];
2519 if (! ((c
>= 'a' && c
<= 'z')
2520 || (c
>= 'A' && c
<= 'Z')
2521 || (c
>= '0' && c
<= '9')
2522 || c
== '-' || c
== '_'))
2523 XSTRING (new)->data
[i
] = '_';
2528 extern char *x_get_string_resource ();
2530 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2531 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2532 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2533 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2534 the name specified by the `-name' or `-rn' command-line arguments.\n\
2536 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2537 class, respectively. You must specify both of them or neither.\n\
2538 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2539 and the class is `Emacs.CLASS.SUBCLASS'.")
2540 (attribute
, class, component
, subclass
)
2541 Lisp_Object attribute
, class, component
, subclass
;
2543 register char *value
;
2549 CHECK_STRING (attribute
, 0);
2550 CHECK_STRING (class, 0);
2552 if (!NILP (component
))
2553 CHECK_STRING (component
, 1);
2554 if (!NILP (subclass
))
2555 CHECK_STRING (subclass
, 2);
2556 if (NILP (component
) != NILP (subclass
))
2557 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2559 validate_x_resource_name ();
2561 /* Allocate space for the components, the dots which separate them,
2562 and the final '\0'. Make them big enough for the worst case. */
2563 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2564 + (STRINGP (component
)
2565 ? STRING_BYTES (XSTRING (component
)) : 0)
2566 + STRING_BYTES (XSTRING (attribute
))
2569 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2570 + STRING_BYTES (XSTRING (class))
2571 + (STRINGP (subclass
)
2572 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2575 /* Start with emacs.FRAMENAME for the name (the specific one)
2576 and with `Emacs' for the class key (the general one). */
2577 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2578 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2580 strcat (class_key
, ".");
2581 strcat (class_key
, XSTRING (class)->data
);
2583 if (!NILP (component
))
2585 strcat (class_key
, ".");
2586 strcat (class_key
, XSTRING (subclass
)->data
);
2588 strcat (name_key
, ".");
2589 strcat (name_key
, XSTRING (component
)->data
);
2592 strcat (name_key
, ".");
2593 strcat (name_key
, XSTRING (attribute
)->data
);
2595 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2596 name_key
, class_key
);
2598 if (value
!= (char *) 0)
2599 return build_string (value
);
2604 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2607 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2608 struct x_display_info
*dpyinfo
;
2609 Lisp_Object attribute
, class, component
, subclass
;
2611 register char *value
;
2615 CHECK_STRING (attribute
, 0);
2616 CHECK_STRING (class, 0);
2618 if (!NILP (component
))
2619 CHECK_STRING (component
, 1);
2620 if (!NILP (subclass
))
2621 CHECK_STRING (subclass
, 2);
2622 if (NILP (component
) != NILP (subclass
))
2623 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2625 validate_x_resource_name ();
2627 /* Allocate space for the components, the dots which separate them,
2628 and the final '\0'. Make them big enough for the worst case. */
2629 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2630 + (STRINGP (component
)
2631 ? STRING_BYTES (XSTRING (component
)) : 0)
2632 + STRING_BYTES (XSTRING (attribute
))
2635 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2636 + STRING_BYTES (XSTRING (class))
2637 + (STRINGP (subclass
)
2638 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2641 /* Start with emacs.FRAMENAME for the name (the specific one)
2642 and with `Emacs' for the class key (the general one). */
2643 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2644 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2646 strcat (class_key
, ".");
2647 strcat (class_key
, XSTRING (class)->data
);
2649 if (!NILP (component
))
2651 strcat (class_key
, ".");
2652 strcat (class_key
, XSTRING (subclass
)->data
);
2654 strcat (name_key
, ".");
2655 strcat (name_key
, XSTRING (component
)->data
);
2658 strcat (name_key
, ".");
2659 strcat (name_key
, XSTRING (attribute
)->data
);
2661 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2663 if (value
!= (char *) 0)
2664 return build_string (value
);
2669 /* Used when C code wants a resource value. */
2672 x_get_resource_string (attribute
, class)
2673 char *attribute
, *class;
2677 struct frame
*sf
= SELECTED_FRAME ();
2679 /* Allocate space for the components, the dots which separate them,
2680 and the final '\0'. */
2681 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2682 + strlen (attribute
) + 2);
2683 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2684 + strlen (class) + 2);
2686 sprintf (name_key
, "%s.%s",
2687 XSTRING (Vinvocation_name
)->data
,
2689 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2691 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2692 name_key
, class_key
);
2695 /* Types we might convert a resource string into. */
2705 /* Return the value of parameter PARAM.
2707 First search ALIST, then Vdefault_frame_alist, then the X defaults
2708 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2710 Convert the resource to the type specified by desired_type.
2712 If no default is specified, return Qunbound. If you call
2713 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2714 and don't let it get stored in any Lisp-visible variables! */
2717 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2718 struct x_display_info
*dpyinfo
;
2719 Lisp_Object alist
, param
;
2722 enum resource_types type
;
2724 register Lisp_Object tem
;
2726 tem
= Fassq (param
, alist
);
2728 tem
= Fassq (param
, Vdefault_frame_alist
);
2734 tem
= display_x_get_resource (dpyinfo
,
2735 build_string (attribute
),
2736 build_string (class),
2744 case RES_TYPE_NUMBER
:
2745 return make_number (atoi (XSTRING (tem
)->data
));
2747 case RES_TYPE_FLOAT
:
2748 return make_float (atof (XSTRING (tem
)->data
));
2750 case RES_TYPE_BOOLEAN
:
2751 tem
= Fdowncase (tem
);
2752 if (!strcmp (XSTRING (tem
)->data
, "on")
2753 || !strcmp (XSTRING (tem
)->data
, "true"))
2758 case RES_TYPE_STRING
:
2761 case RES_TYPE_SYMBOL
:
2762 /* As a special case, we map the values `true' and `on'
2763 to Qt, and `false' and `off' to Qnil. */
2766 lower
= Fdowncase (tem
);
2767 if (!strcmp (XSTRING (lower
)->data
, "on")
2768 || !strcmp (XSTRING (lower
)->data
, "true"))
2770 else if (!strcmp (XSTRING (lower
)->data
, "off")
2771 || !strcmp (XSTRING (lower
)->data
, "false"))
2774 return Fintern (tem
, Qnil
);
2787 /* Like x_get_arg, but also record the value in f->param_alist. */
2790 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2792 Lisp_Object alist
, param
;
2795 enum resource_types type
;
2799 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2800 attribute
, class, type
);
2802 store_frame_param (f
, param
, value
);
2807 /* Record in frame F the specified or default value according to ALIST
2808 of the parameter named PROP (a Lisp symbol).
2809 If no value is specified for PROP, look for an X default for XPROP
2810 on the frame named NAME.
2811 If that is not found either, use the value DEFLT. */
2814 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2821 enum resource_types type
;
2825 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2826 if (EQ (tem
, Qunbound
))
2828 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2833 /* Record in frame F the specified or default value according to ALIST
2834 of the parameter named PROP (a Lisp symbol). If no value is
2835 specified for PROP, look for an X default for XPROP on the frame
2836 named NAME. If that is not found either, use the value DEFLT. */
2839 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2848 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2851 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2852 if (EQ (tem
, Qunbound
))
2854 #ifdef USE_TOOLKIT_SCROLL_BARS
2856 /* See if an X resource for the scroll bar color has been
2858 tem
= display_x_get_resource (dpyinfo
,
2859 build_string (foreground_p
2863 build_string ("verticalScrollBar"),
2867 /* If nothing has been specified, scroll bars will use a
2868 toolkit-dependent default. Because these defaults are
2869 difficult to get at without actually creating a scroll
2870 bar, use nil to indicate that no color has been
2875 #else /* not USE_TOOLKIT_SCROLL_BARS */
2879 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2882 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2888 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2889 "Parse an X-style geometry string STRING.\n\
2890 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2891 The properties returned may include `top', `left', `height', and `width'.\n\
2892 The value of `left' or `top' may be an integer,\n\
2893 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2894 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2899 unsigned int width
, height
;
2902 CHECK_STRING (string
, 0);
2904 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2905 &x
, &y
, &width
, &height
);
2908 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2909 error ("Must specify both x and y position, or neither");
2913 if (geometry
& XValue
)
2915 Lisp_Object element
;
2917 if (x
>= 0 && (geometry
& XNegative
))
2918 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2919 else if (x
< 0 && ! (geometry
& XNegative
))
2920 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2922 element
= Fcons (Qleft
, make_number (x
));
2923 result
= Fcons (element
, result
);
2926 if (geometry
& YValue
)
2928 Lisp_Object element
;
2930 if (y
>= 0 && (geometry
& YNegative
))
2931 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2932 else if (y
< 0 && ! (geometry
& YNegative
))
2933 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2935 element
= Fcons (Qtop
, make_number (y
));
2936 result
= Fcons (element
, result
);
2939 if (geometry
& WidthValue
)
2940 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2941 if (geometry
& HeightValue
)
2942 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2947 /* Calculate the desired size and position of this window,
2948 and return the flags saying which aspects were specified.
2950 This function does not make the coordinates positive. */
2952 #define DEFAULT_ROWS 40
2953 #define DEFAULT_COLS 80
2956 x_figure_window_size (f
, parms
)
2960 register Lisp_Object tem0
, tem1
, tem2
;
2961 long window_prompting
= 0;
2962 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2964 /* Default values if we fall through.
2965 Actually, if that happens we should get
2966 window manager prompting. */
2967 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2968 f
->height
= DEFAULT_ROWS
;
2969 /* Window managers expect that if program-specified
2970 positions are not (0,0), they're intentional, not defaults. */
2971 f
->output_data
.x
->top_pos
= 0;
2972 f
->output_data
.x
->left_pos
= 0;
2974 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2975 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2976 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2977 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2979 if (!EQ (tem0
, Qunbound
))
2981 CHECK_NUMBER (tem0
, 0);
2982 f
->height
= XINT (tem0
);
2984 if (!EQ (tem1
, Qunbound
))
2986 CHECK_NUMBER (tem1
, 0);
2987 SET_FRAME_WIDTH (f
, XINT (tem1
));
2989 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2990 window_prompting
|= USSize
;
2992 window_prompting
|= PSize
;
2995 f
->output_data
.x
->vertical_scroll_bar_extra
2996 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2998 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2999 f
->output_data
.x
->flags_areas_extra
3000 = FRAME_FLAGS_AREA_WIDTH (f
);
3001 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3002 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3004 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3005 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3006 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3007 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3009 if (EQ (tem0
, Qminus
))
3011 f
->output_data
.x
->top_pos
= 0;
3012 window_prompting
|= YNegative
;
3014 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3015 && CONSP (XCDR (tem0
))
3016 && INTEGERP (XCAR (XCDR (tem0
))))
3018 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3019 window_prompting
|= YNegative
;
3021 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3022 && CONSP (XCDR (tem0
))
3023 && INTEGERP (XCAR (XCDR (tem0
))))
3025 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3027 else if (EQ (tem0
, Qunbound
))
3028 f
->output_data
.x
->top_pos
= 0;
3031 CHECK_NUMBER (tem0
, 0);
3032 f
->output_data
.x
->top_pos
= XINT (tem0
);
3033 if (f
->output_data
.x
->top_pos
< 0)
3034 window_prompting
|= YNegative
;
3037 if (EQ (tem1
, Qminus
))
3039 f
->output_data
.x
->left_pos
= 0;
3040 window_prompting
|= XNegative
;
3042 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3043 && CONSP (XCDR (tem1
))
3044 && INTEGERP (XCAR (XCDR (tem1
))))
3046 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3047 window_prompting
|= XNegative
;
3049 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3050 && CONSP (XCDR (tem1
))
3051 && INTEGERP (XCAR (XCDR (tem1
))))
3053 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3055 else if (EQ (tem1
, Qunbound
))
3056 f
->output_data
.x
->left_pos
= 0;
3059 CHECK_NUMBER (tem1
, 0);
3060 f
->output_data
.x
->left_pos
= XINT (tem1
);
3061 if (f
->output_data
.x
->left_pos
< 0)
3062 window_prompting
|= XNegative
;
3065 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3066 window_prompting
|= USPosition
;
3068 window_prompting
|= PPosition
;
3071 return window_prompting
;
3074 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3077 XSetWMProtocols (dpy
, w
, protocols
, count
)
3084 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3085 if (prop
== None
) return False
;
3086 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3087 (unsigned char *) protocols
, count
);
3090 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3092 #ifdef USE_X_TOOLKIT
3094 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3095 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3096 already be present because of the toolkit (Motif adds some of them,
3097 for example, but Xt doesn't). */
3100 hack_wm_protocols (f
, widget
)
3104 Display
*dpy
= XtDisplay (widget
);
3105 Window w
= XtWindow (widget
);
3106 int need_delete
= 1;
3112 Atom type
, *atoms
= 0;
3114 unsigned long nitems
= 0;
3115 unsigned long bytes_after
;
3117 if ((XGetWindowProperty (dpy
, w
,
3118 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3119 (long)0, (long)100, False
, XA_ATOM
,
3120 &type
, &format
, &nitems
, &bytes_after
,
3121 (unsigned char **) &atoms
)
3123 && format
== 32 && type
== XA_ATOM
)
3127 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3129 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3131 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3134 if (atoms
) XFree ((char *) atoms
);
3140 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3142 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3144 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3146 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3147 XA_ATOM
, 32, PropModeAppend
,
3148 (unsigned char *) props
, count
);
3156 /* Support routines for XIC (X Input Context). */
3160 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3161 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3164 /* Supported XIM styles, ordered by preferenc. */
3166 static XIMStyle supported_xim_styles
[] =
3168 XIMPreeditPosition
| XIMStatusArea
,
3169 XIMPreeditPosition
| XIMStatusNothing
,
3170 XIMPreeditPosition
| XIMStatusNone
,
3171 XIMPreeditNothing
| XIMStatusArea
,
3172 XIMPreeditNothing
| XIMStatusNothing
,
3173 XIMPreeditNothing
| XIMStatusNone
,
3174 XIMPreeditNone
| XIMStatusArea
,
3175 XIMPreeditNone
| XIMStatusNothing
,
3176 XIMPreeditNone
| XIMStatusNone
,
3181 /* Create an X fontset on frame F with base font name
3185 xic_create_xfontset (f
, base_fontname
)
3187 char *base_fontname
;
3190 char **missing_list
;
3194 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3195 base_fontname
, &missing_list
,
3196 &missing_count
, &def_string
);
3198 XFreeStringList (missing_list
);
3200 /* No need to free def_string. */
3205 /* Value is the best input style, given user preferences USER (already
3206 checked to be supported by Emacs), and styles supported by the
3207 input method XIM. */
3210 best_xim_style (user
, xim
)
3216 for (i
= 0; i
< user
->count_styles
; ++i
)
3217 for (j
= 0; j
< xim
->count_styles
; ++j
)
3218 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3219 return user
->supported_styles
[i
];
3221 /* Return the default style. */
3222 return XIMPreeditNothing
| XIMStatusNothing
;
3225 /* Create XIC for frame F. */
3228 create_frame_xic (f
)
3233 XFontSet xfs
= NULL
;
3234 static XIMStyle xic_style
;
3239 xim
= FRAME_X_XIM (f
);
3244 XVaNestedList preedit_attr
;
3245 XVaNestedList status_attr
;
3246 char *base_fontname
;
3249 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3250 spot
.x
= 0; spot
.y
= 1;
3251 /* Create X fontset. */
3252 fontset
= FRAME_FONTSET (f
);
3254 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3257 /* Determine the base fontname from the ASCII font name of
3259 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3260 char *p
= ascii_font
;
3263 for (i
= 0; *p
; p
++)
3266 /* As the font name doesn't conform to XLFD, we can't
3267 modify it to get a suitable base fontname for the
3269 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3272 int len
= strlen (ascii_font
) + 1;
3275 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3284 base_fontname
= (char *) alloca (len
);
3285 bzero (base_fontname
, len
);
3286 strcpy (base_fontname
, "-*-*-");
3287 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3288 strcat (base_fontname
, "*-*-*-*-*-*-*");
3291 xfs
= xic_create_xfontset (f
, base_fontname
);
3293 /* Determine XIC style. */
3296 XIMStyles supported_list
;
3297 supported_list
.count_styles
= (sizeof supported_xim_styles
3298 / sizeof supported_xim_styles
[0]);
3299 supported_list
.supported_styles
= supported_xim_styles
;
3300 xic_style
= best_xim_style (&supported_list
,
3301 FRAME_X_XIM_STYLES (f
));
3304 preedit_attr
= XVaCreateNestedList (0,
3307 FRAME_FOREGROUND_PIXEL (f
),
3309 FRAME_BACKGROUND_PIXEL (f
),
3310 (xic_style
& XIMPreeditPosition
3315 status_attr
= XVaCreateNestedList (0,
3321 FRAME_FOREGROUND_PIXEL (f
),
3323 FRAME_BACKGROUND_PIXEL (f
),
3326 xic
= XCreateIC (xim
,
3327 XNInputStyle
, xic_style
,
3328 XNClientWindow
, FRAME_X_WINDOW(f
),
3329 XNFocusWindow
, FRAME_X_WINDOW(f
),
3330 XNStatusAttributes
, status_attr
,
3331 XNPreeditAttributes
, preedit_attr
,
3333 XFree (preedit_attr
);
3334 XFree (status_attr
);
3337 FRAME_XIC (f
) = xic
;
3338 FRAME_XIC_STYLE (f
) = xic_style
;
3339 FRAME_XIC_FONTSET (f
) = xfs
;
3343 /* Destroy XIC and free XIC fontset of frame F, if any. */
3349 if (FRAME_XIC (f
) == NULL
)
3352 XDestroyIC (FRAME_XIC (f
));
3353 if (FRAME_XIC_FONTSET (f
))
3354 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3356 FRAME_XIC (f
) = NULL
;
3357 FRAME_XIC_FONTSET (f
) = NULL
;
3361 /* Place preedit area for XIC of window W's frame to specified
3362 pixel position X/Y. X and Y are relative to window W. */
3365 xic_set_preeditarea (w
, x
, y
)
3369 struct frame
*f
= XFRAME (w
->frame
);
3373 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3374 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3375 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3376 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3381 /* Place status area for XIC in bottom right corner of frame F.. */
3384 xic_set_statusarea (f
)
3387 XIC xic
= FRAME_XIC (f
);
3392 /* Negotiate geometry of status area. If input method has existing
3393 status area, use its current size. */
3394 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3395 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3396 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3399 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3400 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3403 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3405 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3406 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3410 area
.width
= needed
->width
;
3411 area
.height
= needed
->height
;
3412 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3413 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3414 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3417 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3418 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3423 /* Set X fontset for XIC of frame F, using base font name
3424 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3427 xic_set_xfontset (f
, base_fontname
)
3429 char *base_fontname
;
3434 xfs
= xic_create_xfontset (f
, base_fontname
);
3436 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3437 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3438 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3439 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3440 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3443 if (FRAME_XIC_FONTSET (f
))
3444 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3445 FRAME_XIC_FONTSET (f
) = xfs
;
3448 #endif /* HAVE_X_I18N */
3452 #ifdef USE_X_TOOLKIT
3454 /* Create and set up the X widget for frame F. */
3457 x_window (f
, window_prompting
, minibuffer_only
)
3459 long window_prompting
;
3460 int minibuffer_only
;
3462 XClassHint class_hints
;
3463 XSetWindowAttributes attributes
;
3464 unsigned long attribute_mask
;
3465 Widget shell_widget
;
3467 Widget frame_widget
;
3473 /* Use the resource name as the top-level widget name
3474 for looking up resources. Make a non-Lisp copy
3475 for the window manager, so GC relocation won't bother it.
3477 Elsewhere we specify the window name for the window manager. */
3480 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3481 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3482 strcpy (f
->namebuf
, str
);
3486 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3487 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3488 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3489 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3490 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3491 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3492 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3493 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3494 applicationShellWidgetClass
,
3495 FRAME_X_DISPLAY (f
), al
, ac
);
3497 f
->output_data
.x
->widget
= shell_widget
;
3498 /* maybe_set_screen_title_format (shell_widget); */
3500 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3501 (widget_value
*) NULL
,
3502 shell_widget
, False
,
3506 (lw_callback
) NULL
);
3509 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3510 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3511 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3512 XtSetValues (pane_widget
, al
, ac
);
3513 f
->output_data
.x
->column_widget
= pane_widget
;
3515 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3516 the emacs screen when changing menubar. This reduces flickering. */
3519 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3520 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3521 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3522 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3523 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3524 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3525 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3526 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3527 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3530 f
->output_data
.x
->edit_widget
= frame_widget
;
3532 XtManageChild (frame_widget
);
3534 /* Do some needed geometry management. */
3537 char *tem
, shell_position
[32];
3540 int extra_borders
= 0;
3542 = (f
->output_data
.x
->menubar_widget
3543 ? (f
->output_data
.x
->menubar_widget
->core
.height
3544 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3547 #if 0 /* Experimentally, we now get the right results
3548 for -geometry -0-0 without this. 24 Aug 96, rms. */
3549 if (FRAME_EXTERNAL_MENU_BAR (f
))
3552 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3553 menubar_size
+= ibw
;
3557 f
->output_data
.x
->menubar_height
= menubar_size
;
3560 /* Motif seems to need this amount added to the sizes
3561 specified for the shell widget. The Athena/Lucid widgets don't.
3562 Both conclusions reached experimentally. -- rms. */
3563 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3564 &extra_borders
, NULL
);
3568 /* Convert our geometry parameters into a geometry string
3570 Note that we do not specify here whether the position
3571 is a user-specified or program-specified one.
3572 We pass that information later, in x_wm_set_size_hints. */
3574 int left
= f
->output_data
.x
->left_pos
;
3575 int xneg
= window_prompting
& XNegative
;
3576 int top
= f
->output_data
.x
->top_pos
;
3577 int yneg
= window_prompting
& YNegative
;
3583 if (window_prompting
& USPosition
)
3584 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3585 PIXEL_WIDTH (f
) + extra_borders
,
3586 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3587 (xneg
? '-' : '+'), left
,
3588 (yneg
? '-' : '+'), top
);
3590 sprintf (shell_position
, "=%dx%d",
3591 PIXEL_WIDTH (f
) + extra_borders
,
3592 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3595 len
= strlen (shell_position
) + 1;
3596 /* We don't free this because we don't know whether
3597 it is safe to free it while the frame exists.
3598 It isn't worth the trouble of arranging to free it
3599 when the frame is deleted. */
3600 tem
= (char *) xmalloc (len
);
3601 strncpy (tem
, shell_position
, len
);
3602 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3603 XtSetValues (shell_widget
, al
, ac
);
3606 XtManageChild (pane_widget
);
3607 XtRealizeWidget (shell_widget
);
3609 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3611 validate_x_resource_name ();
3613 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3614 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3615 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3618 FRAME_XIC (f
) = NULL
;
3620 create_frame_xic (f
);
3624 f
->output_data
.x
->wm_hints
.input
= True
;
3625 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3626 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3627 &f
->output_data
.x
->wm_hints
);
3629 hack_wm_protocols (f
, shell_widget
);
3632 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3635 /* Do a stupid property change to force the server to generate a
3636 PropertyNotify event so that the event_stream server timestamp will
3637 be initialized to something relevant to the time we created the window.
3639 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3640 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3641 XA_ATOM
, 32, PropModeAppend
,
3642 (unsigned char*) NULL
, 0);
3644 /* Make all the standard events reach the Emacs frame. */
3645 attributes
.event_mask
= STANDARD_EVENT_SET
;
3650 /* XIM server might require some X events. */
3651 unsigned long fevent
= NoEventMask
;
3652 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3653 attributes
.event_mask
|= fevent
;
3655 #endif /* HAVE_X_I18N */
3657 attribute_mask
= CWEventMask
;
3658 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3659 attribute_mask
, &attributes
);
3661 XtMapWidget (frame_widget
);
3663 /* x_set_name normally ignores requests to set the name if the
3664 requested name is the same as the current name. This is the one
3665 place where that assumption isn't correct; f->name is set, but
3666 the X server hasn't been told. */
3669 int explicit = f
->explicit_name
;
3671 f
->explicit_name
= 0;
3674 x_set_name (f
, name
, explicit);
3677 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3678 f
->output_data
.x
->text_cursor
);
3682 /* This is a no-op, except under Motif. Make sure main areas are
3683 set to something reasonable, in case we get an error later. */
3684 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3687 #else /* not USE_X_TOOLKIT */
3689 /* Create and set up the X window for frame F. */
3696 XClassHint class_hints
;
3697 XSetWindowAttributes attributes
;
3698 unsigned long attribute_mask
;
3700 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3701 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3702 attributes
.bit_gravity
= StaticGravity
;
3703 attributes
.backing_store
= NotUseful
;
3704 attributes
.save_under
= True
;
3705 attributes
.event_mask
= STANDARD_EVENT_SET
;
3706 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3707 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3712 = XCreateWindow (FRAME_X_DISPLAY (f
),
3713 f
->output_data
.x
->parent_desc
,
3714 f
->output_data
.x
->left_pos
,
3715 f
->output_data
.x
->top_pos
,
3716 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3717 f
->output_data
.x
->border_width
,
3718 CopyFromParent
, /* depth */
3719 InputOutput
, /* class */
3721 attribute_mask
, &attributes
);
3725 create_frame_xic (f
);
3728 /* XIM server might require some X events. */
3729 unsigned long fevent
= NoEventMask
;
3730 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3731 attributes
.event_mask
|= fevent
;
3732 attribute_mask
= CWEventMask
;
3733 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3734 attribute_mask
, &attributes
);
3737 #endif /* HAVE_X_I18N */
3739 validate_x_resource_name ();
3741 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3742 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3743 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3745 /* The menubar is part of the ordinary display;
3746 it does not count in addition to the height of the window. */
3747 f
->output_data
.x
->menubar_height
= 0;
3749 /* This indicates that we use the "Passive Input" input model.
3750 Unless we do this, we don't get the Focus{In,Out} events that we
3751 need to draw the cursor correctly. Accursed bureaucrats.
3752 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3754 f
->output_data
.x
->wm_hints
.input
= True
;
3755 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3756 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3757 &f
->output_data
.x
->wm_hints
);
3758 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3760 /* Request "save yourself" and "delete window" commands from wm. */
3763 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3764 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3765 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3768 /* x_set_name normally ignores requests to set the name if the
3769 requested name is the same as the current name. This is the one
3770 place where that assumption isn't correct; f->name is set, but
3771 the X server hasn't been told. */
3774 int explicit = f
->explicit_name
;
3776 f
->explicit_name
= 0;
3779 x_set_name (f
, name
, explicit);
3782 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3783 f
->output_data
.x
->text_cursor
);
3787 if (FRAME_X_WINDOW (f
) == 0)
3788 error ("Unable to create window");
3791 #endif /* not USE_X_TOOLKIT */
3793 /* Handle the icon stuff for this window. Perhaps later we might
3794 want an x_set_icon_position which can be called interactively as
3802 Lisp_Object icon_x
, icon_y
;
3803 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3805 /* Set the position of the icon. Note that twm groups all
3806 icons in an icon window. */
3807 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3808 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3809 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3811 CHECK_NUMBER (icon_x
, 0);
3812 CHECK_NUMBER (icon_y
, 0);
3814 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3815 error ("Both left and top icon corners of icon must be specified");
3819 if (! EQ (icon_x
, Qunbound
))
3820 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3822 /* Start up iconic or window? */
3823 x_wm_set_window_state
3824 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3829 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3836 /* Make the GC's needed for this window, setting the
3837 background, border and mouse colors; also create the
3838 mouse cursor and the gray border tile. */
3840 static char cursor_bits
[] =
3842 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3843 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3844 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3845 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3852 XGCValues gc_values
;
3856 /* Create the GC's of this frame.
3857 Note that many default values are used. */
3860 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3861 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3862 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3863 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3864 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3866 GCLineWidth
| GCFont
3867 | GCForeground
| GCBackground
,
3870 /* Reverse video style. */
3871 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3872 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3873 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3875 GCFont
| GCForeground
| GCBackground
3879 /* Cursor has cursor-color background, background-color foreground. */
3880 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3881 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3882 gc_values
.fill_style
= FillOpaqueStippled
;
3884 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3885 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3886 cursor_bits
, 16, 16);
3887 f
->output_data
.x
->cursor_gc
3888 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3889 (GCFont
| GCForeground
| GCBackground
3890 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3894 f
->output_data
.x
->white_relief
.gc
= 0;
3895 f
->output_data
.x
->black_relief
.gc
= 0;
3897 /* Create the gray border tile used when the pointer is not in
3898 the frame. Since this depends on the frame's pixel values,
3899 this must be done on a per-frame basis. */
3900 f
->output_data
.x
->border_tile
3901 = (XCreatePixmapFromBitmapData
3902 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3903 gray_bits
, gray_width
, gray_height
,
3904 f
->output_data
.x
->foreground_pixel
,
3905 f
->output_data
.x
->background_pixel
,
3906 DefaultDepth (FRAME_X_DISPLAY (f
),
3907 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3912 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3914 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3915 Returns an Emacs frame object.\n\
3916 ALIST is an alist of frame parameters.\n\
3917 If the parameters specify that the frame should not have a minibuffer,\n\
3918 and do not specify a specific minibuffer window to use,\n\
3919 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3920 be shared by the new frame.\n\
3922 This function is an internal primitive--use `make-frame' instead.")
3927 Lisp_Object frame
, tem
;
3929 int minibuffer_only
= 0;
3930 long window_prompting
= 0;
3932 int count
= specpdl_ptr
- specpdl
;
3933 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3934 Lisp_Object display
;
3935 struct x_display_info
*dpyinfo
= NULL
;
3941 /* Use this general default value to start with
3942 until we know if this frame has a specified name. */
3943 Vx_resource_name
= Vinvocation_name
;
3945 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3946 if (EQ (display
, Qunbound
))
3948 dpyinfo
= check_x_display_info (display
);
3950 kb
= dpyinfo
->kboard
;
3952 kb
= &the_only_kboard
;
3955 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3957 && ! EQ (name
, Qunbound
)
3959 error ("Invalid frame name--not a string or nil");
3962 Vx_resource_name
= name
;
3964 /* See if parent window is specified. */
3965 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3966 if (EQ (parent
, Qunbound
))
3968 if (! NILP (parent
))
3969 CHECK_NUMBER (parent
, 0);
3971 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3972 /* No need to protect DISPLAY because that's not used after passing
3973 it to make_frame_without_minibuffer. */
3975 GCPRO4 (parms
, parent
, name
, frame
);
3976 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3978 if (EQ (tem
, Qnone
) || NILP (tem
))
3979 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3980 else if (EQ (tem
, Qonly
))
3982 f
= make_minibuffer_frame ();
3983 minibuffer_only
= 1;
3985 else if (WINDOWP (tem
))
3986 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3990 XSETFRAME (frame
, f
);
3992 /* Note that X Windows does support scroll bars. */
3993 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3995 f
->output_method
= output_x_window
;
3996 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3997 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3998 f
->output_data
.x
->icon_bitmap
= -1;
3999 f
->output_data
.x
->fontset
= -1;
4000 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4001 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4004 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4006 if (! STRINGP (f
->icon_name
))
4007 f
->icon_name
= Qnil
;
4009 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4011 FRAME_KBOARD (f
) = kb
;
4014 /* These colors will be set anyway later, but it's important
4015 to get the color reference counts right, so initialize them! */
4018 struct gcpro gcpro1
;
4020 black
= build_string ("black");
4022 f
->output_data
.x
->foreground_pixel
4023 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4024 f
->output_data
.x
->background_pixel
4025 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4026 f
->output_data
.x
->cursor_pixel
4027 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4028 f
->output_data
.x
->cursor_foreground_pixel
4029 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4030 f
->output_data
.x
->border_pixel
4031 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4032 f
->output_data
.x
->mouse_pixel
4033 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4037 /* Specify the parent under which to make this X window. */
4041 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4042 f
->output_data
.x
->explicit_parent
= 1;
4046 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4047 f
->output_data
.x
->explicit_parent
= 0;
4050 /* Set the name; the functions to which we pass f expect the name to
4052 if (EQ (name
, Qunbound
) || NILP (name
))
4054 f
->name
= build_string (dpyinfo
->x_id_name
);
4055 f
->explicit_name
= 0;
4060 f
->explicit_name
= 1;
4061 /* use the frame's title when getting resources for this frame. */
4062 specbind (Qx_resource_name
, name
);
4065 /* Extract the window parameters from the supplied values
4066 that are needed to determine window geometry. */
4070 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4073 /* First, try whatever font the caller has specified. */
4076 tem
= Fquery_fontset (font
, Qnil
);
4078 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4080 font
= x_new_font (f
, XSTRING (font
)->data
);
4083 /* Try out a font which we hope has bold and italic variations. */
4084 if (!STRINGP (font
))
4085 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4086 if (!STRINGP (font
))
4087 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4088 if (! STRINGP (font
))
4089 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4090 if (! STRINGP (font
))
4091 /* This was formerly the first thing tried, but it finds too many fonts
4092 and takes too long. */
4093 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4094 /* If those didn't work, look for something which will at least work. */
4095 if (! STRINGP (font
))
4096 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4098 if (! STRINGP (font
))
4099 font
= build_string ("fixed");
4101 x_default_parameter (f
, parms
, Qfont
, font
,
4102 "font", "Font", RES_TYPE_STRING
);
4106 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4107 whereby it fails to get any font. */
4108 xlwmenu_default_font
= f
->output_data
.x
->font
;
4111 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4112 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4114 /* This defaults to 2 in order to match xterm. We recognize either
4115 internalBorderWidth or internalBorder (which is what xterm calls
4117 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4121 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4122 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4123 if (! EQ (value
, Qunbound
))
4124 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4127 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4128 "internalBorderWidth", "internalBorderWidth",
4130 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4131 "verticalScrollBars", "ScrollBars",
4134 /* Also do the stuff which must be set before the window exists. */
4135 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4136 "foreground", "Foreground", RES_TYPE_STRING
);
4137 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4138 "background", "Background", RES_TYPE_STRING
);
4139 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4140 "pointerColor", "Foreground", RES_TYPE_STRING
);
4141 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4142 "cursorColor", "Foreground", RES_TYPE_STRING
);
4143 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4144 "borderColor", "BorderColor", RES_TYPE_STRING
);
4145 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4146 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4147 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4148 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4150 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4151 "scrollBarForeground",
4152 "ScrollBarForeground", 1);
4153 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4154 "scrollBarBackground",
4155 "ScrollBarBackground", 0);
4157 /* Init faces before x_default_parameter is called for scroll-bar
4158 parameters because that function calls x_set_scroll_bar_width,
4159 which calls change_frame_size, which calls Fset_window_buffer,
4160 which runs hooks, which call Fvertical_motion. At the end, we
4161 end up in init_iterator with a null face cache, which should not
4163 init_frame_faces (f
);
4165 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4166 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4167 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
4168 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4169 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4170 "bufferPredicate", "BufferPredicate",
4172 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4173 "title", "Title", RES_TYPE_STRING
);
4175 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4176 window_prompting
= x_figure_window_size (f
, parms
);
4178 if (window_prompting
& XNegative
)
4180 if (window_prompting
& YNegative
)
4181 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4183 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4187 if (window_prompting
& YNegative
)
4188 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4190 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4193 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4195 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4196 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4198 /* Create the X widget or window. Add the tool-bar height to the
4199 initial frame height so that the user gets a text display area of
4200 the size he specified with -g or via .Xdefaults. Later changes
4201 of the tool-bar height don't change the frame size. This is done
4202 so that users can create tall Emacs frames without having to
4203 guess how tall the tool-bar will get. */
4204 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4206 #ifdef USE_X_TOOLKIT
4207 x_window (f
, window_prompting
, minibuffer_only
);
4215 /* Now consider the frame official. */
4216 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4217 Vframe_list
= Fcons (frame
, Vframe_list
);
4219 /* We need to do this after creating the X window, so that the
4220 icon-creation functions can say whose icon they're describing. */
4221 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4222 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4224 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4225 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4226 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4227 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4228 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4229 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4230 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4231 "scrollBarWidth", "ScrollBarWidth",
4234 /* Dimensions, especially f->height, must be done via change_frame_size.
4235 Change will not be effected unless different from the current
4240 SET_FRAME_WIDTH (f
, 0);
4241 change_frame_size (f
, height
, width
, 1, 0, 0);
4243 /* Set up faces after all frame parameters are known. */
4244 call1 (Qface_set_after_frame_default
, frame
);
4246 #ifdef USE_X_TOOLKIT
4247 /* Create the menu bar. */
4248 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4250 /* If this signals an error, we haven't set size hints for the
4251 frame and we didn't make it visible. */
4252 initialize_frame_menubar (f
);
4254 /* This is a no-op, except under Motif where it arranges the
4255 main window for the widgets on it. */
4256 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4257 f
->output_data
.x
->menubar_widget
,
4258 f
->output_data
.x
->edit_widget
);
4260 #endif /* USE_X_TOOLKIT */
4262 /* Tell the server what size and position, etc, we want, and how
4263 badly we want them. This should be done after we have the menu
4264 bar so that its size can be taken into account. */
4266 x_wm_set_size_hint (f
, window_prompting
, 0);
4269 /* Make the window appear on the frame and enable display, unless
4270 the caller says not to. However, with explicit parent, Emacs
4271 cannot control visibility, so don't try. */
4272 if (! f
->output_data
.x
->explicit_parent
)
4274 Lisp_Object visibility
;
4276 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4278 if (EQ (visibility
, Qunbound
))
4281 if (EQ (visibility
, Qicon
))
4282 x_iconify_frame (f
);
4283 else if (! NILP (visibility
))
4284 x_make_frame_visible (f
);
4286 /* Must have been Qnil. */
4291 return unbind_to (count
, frame
);
4294 /* FRAME is used only to get a handle on the X display. We don't pass the
4295 display info directly because we're called from frame.c, which doesn't
4296 know about that structure. */
4299 x_get_focus_frame (frame
)
4300 struct frame
*frame
;
4302 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4304 if (! dpyinfo
->x_focus_frame
)
4307 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4312 /* In certain situations, when the window manager follows a
4313 click-to-focus policy, there seems to be no way around calling
4314 XSetInputFocus to give another frame the input focus .
4316 In an ideal world, XSetInputFocus should generally be avoided so
4317 that applications don't interfere with the window manager's focus
4318 policy. But I think it's okay to use when it's clearly done
4319 following a user-command. */
4321 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4322 "Set the input focus to FRAME.\n\
4323 FRAME nil means use the selected frame.")
4327 struct frame
*f
= check_x_frame (frame
);
4328 Display
*dpy
= FRAME_X_DISPLAY (f
);
4332 count
= x_catch_errors (dpy
);
4333 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4334 RevertToParent
, CurrentTime
);
4335 x_uncatch_errors (dpy
, count
);
4342 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4343 "Internal function called by `color-defined-p', which see.")
4345 Lisp_Object color
, frame
;
4348 FRAME_PTR f
= check_x_frame (frame
);
4350 CHECK_STRING (color
, 1);
4352 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4358 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4359 "Internal function called by `color-values', which see.")
4361 Lisp_Object color
, frame
;
4364 FRAME_PTR f
= check_x_frame (frame
);
4366 CHECK_STRING (color
, 1);
4368 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4372 rgb
[0] = make_number (foo
.red
);
4373 rgb
[1] = make_number (foo
.green
);
4374 rgb
[2] = make_number (foo
.blue
);
4375 return Flist (3, rgb
);
4381 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4382 "Internal function called by `display-color-p', which see.")
4384 Lisp_Object display
;
4386 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4388 if (dpyinfo
->n_planes
<= 2)
4391 switch (dpyinfo
->visual
->class)
4404 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4406 "Return t if the X display supports shades of gray.\n\
4407 Note that color displays do support shades of gray.\n\
4408 The optional argument DISPLAY specifies which display to ask about.\n\
4409 DISPLAY should be either a frame or a display name (a string).\n\
4410 If omitted or nil, that stands for the selected frame's display.")
4412 Lisp_Object display
;
4414 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4416 if (dpyinfo
->n_planes
<= 1)
4419 switch (dpyinfo
->visual
->class)
4434 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4436 "Returns the width in pixels of the X display DISPLAY.\n\
4437 The optional argument DISPLAY specifies which display to ask about.\n\
4438 DISPLAY should be either a frame or a display name (a string).\n\
4439 If omitted or nil, that stands for the selected frame's display.")
4441 Lisp_Object display
;
4443 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4445 return make_number (dpyinfo
->width
);
4448 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4449 Sx_display_pixel_height
, 0, 1, 0,
4450 "Returns the height in pixels of the X display DISPLAY.\n\
4451 The optional argument DISPLAY specifies which display to ask about.\n\
4452 DISPLAY should be either a frame or a display name (a string).\n\
4453 If omitted or nil, that stands for the selected frame's display.")
4455 Lisp_Object display
;
4457 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4459 return make_number (dpyinfo
->height
);
4462 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4464 "Returns the number of bitplanes of the X display DISPLAY.\n\
4465 The optional argument DISPLAY specifies which display to ask about.\n\
4466 DISPLAY should be either a frame or a display name (a string).\n\
4467 If omitted or nil, that stands for the selected frame's display.")
4469 Lisp_Object display
;
4471 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4473 return make_number (dpyinfo
->n_planes
);
4476 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4478 "Returns the number of color cells of the X display DISPLAY.\n\
4479 The optional argument DISPLAY specifies which display to ask about.\n\
4480 DISPLAY should be either a frame or a display name (a string).\n\
4481 If omitted or nil, that stands for the selected frame's display.")
4483 Lisp_Object display
;
4485 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4487 return make_number (DisplayCells (dpyinfo
->display
,
4488 XScreenNumberOfScreen (dpyinfo
->screen
)));
4491 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4492 Sx_server_max_request_size
,
4494 "Returns the maximum request size of the X server of display DISPLAY.\n\
4495 The optional argument DISPLAY specifies which display to ask about.\n\
4496 DISPLAY should be either a frame or a display name (a string).\n\
4497 If omitted or nil, that stands for the selected frame's display.")
4499 Lisp_Object display
;
4501 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4503 return make_number (MAXREQUEST (dpyinfo
->display
));
4506 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4507 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4508 The optional argument DISPLAY specifies which display to ask about.\n\
4509 DISPLAY should be either a frame or a display name (a string).\n\
4510 If omitted or nil, that stands for the selected frame's display.")
4512 Lisp_Object display
;
4514 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4515 char *vendor
= ServerVendor (dpyinfo
->display
);
4517 if (! vendor
) vendor
= "";
4518 return build_string (vendor
);
4521 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4522 "Returns the version numbers of the X server of display DISPLAY.\n\
4523 The value is a list of three integers: the major and minor\n\
4524 version numbers of the X Protocol in use, and the vendor-specific release\n\
4525 number. See also the function `x-server-vendor'.\n\n\
4526 The optional argument DISPLAY specifies which display to ask about.\n\
4527 DISPLAY should be either a frame or a display name (a string).\n\
4528 If omitted or nil, that stands for the selected frame's display.")
4530 Lisp_Object display
;
4532 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4533 Display
*dpy
= dpyinfo
->display
;
4535 return Fcons (make_number (ProtocolVersion (dpy
)),
4536 Fcons (make_number (ProtocolRevision (dpy
)),
4537 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4540 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4541 "Returns the number of screens on the X server of display DISPLAY.\n\
4542 The optional argument DISPLAY specifies which display to ask about.\n\
4543 DISPLAY should be either a frame or a display name (a string).\n\
4544 If omitted or nil, that stands for the selected frame's display.")
4546 Lisp_Object display
;
4548 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4550 return make_number (ScreenCount (dpyinfo
->display
));
4553 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4554 "Returns the height in millimeters of the X display DISPLAY.\n\
4555 The optional argument DISPLAY specifies which display to ask about.\n\
4556 DISPLAY should be either a frame or a display name (a string).\n\
4557 If omitted or nil, that stands for the selected frame's display.")
4559 Lisp_Object display
;
4561 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4563 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4566 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4567 "Returns the width in millimeters of the X display DISPLAY.\n\
4568 The optional argument DISPLAY specifies which display to ask about.\n\
4569 DISPLAY should be either a frame or a display name (a string).\n\
4570 If omitted or nil, that stands for the selected frame's display.")
4572 Lisp_Object display
;
4574 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4576 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4579 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4580 Sx_display_backing_store
, 0, 1, 0,
4581 "Returns an indication of whether X display DISPLAY does backing store.\n\
4582 The value may be `always', `when-mapped', or `not-useful'.\n\
4583 The optional argument DISPLAY specifies which display to ask about.\n\
4584 DISPLAY should be either a frame or a display name (a string).\n\
4585 If omitted or nil, that stands for the selected frame's display.")
4587 Lisp_Object display
;
4589 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4592 switch (DoesBackingStore (dpyinfo
->screen
))
4595 result
= intern ("always");
4599 result
= intern ("when-mapped");
4603 result
= intern ("not-useful");
4607 error ("Strange value for BackingStore parameter of screen");
4614 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4615 Sx_display_visual_class
, 0, 1, 0,
4616 "Returns the visual class of the X display DISPLAY.\n\
4617 The value is one of the symbols `static-gray', `gray-scale',\n\
4618 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4619 The optional argument DISPLAY specifies which display to ask about.\n\
4620 DISPLAY should be either a frame or a display name (a string).\n\
4621 If omitted or nil, that stands for the selected frame's display.")
4623 Lisp_Object display
;
4625 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4628 switch (dpyinfo
->visual
->class)
4631 result
= intern ("static-gray");
4634 result
= intern ("gray-scale");
4637 result
= intern ("static-color");
4640 result
= intern ("pseudo-color");
4643 result
= intern ("true-color");
4646 result
= intern ("direct-color");
4649 error ("Display has an unknown visual class");
4656 DEFUN ("x-display-save-under", Fx_display_save_under
,
4657 Sx_display_save_under
, 0, 1, 0,
4658 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4659 The optional argument DISPLAY specifies which display to ask about.\n\
4660 DISPLAY should be either a frame or a display name (a string).\n\
4661 If omitted or nil, that stands for the selected frame's display.")
4663 Lisp_Object display
;
4665 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4667 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4675 register struct frame
*f
;
4677 return PIXEL_WIDTH (f
);
4682 register struct frame
*f
;
4684 return PIXEL_HEIGHT (f
);
4689 register struct frame
*f
;
4691 return FONT_WIDTH (f
->output_data
.x
->font
);
4696 register struct frame
*f
;
4698 return f
->output_data
.x
->line_height
;
4703 register struct frame
*f
;
4705 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4710 /************************************************************************
4712 ************************************************************************/
4715 /* Mapping visual names to visuals. */
4717 static struct visual_class
4724 {"StaticGray", StaticGray
},
4725 {"GrayScale", GrayScale
},
4726 {"StaticColor", StaticColor
},
4727 {"PseudoColor", PseudoColor
},
4728 {"TrueColor", TrueColor
},
4729 {"DirectColor", DirectColor
},
4734 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4736 /* Value is the screen number of screen SCR. This is a substitute for
4737 the X function with the same name when that doesn't exist. */
4740 XScreenNumberOfScreen (scr
)
4741 register Screen
*scr
;
4743 Display
*dpy
= scr
->display
;
4746 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4747 if (scr
== dpy
->screens
[i
])
4753 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4756 /* Select the visual that should be used on display DPYINFO. Set
4757 members of DPYINFO appropriately. Called from x_term_init. */
4760 select_visual (dpyinfo
)
4761 struct x_display_info
*dpyinfo
;
4763 Display
*dpy
= dpyinfo
->display
;
4764 Screen
*screen
= dpyinfo
->screen
;
4767 /* See if a visual is specified. */
4768 value
= display_x_get_resource (dpyinfo
,
4769 build_string ("visualClass"),
4770 build_string ("VisualClass"),
4772 if (STRINGP (value
))
4774 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4775 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4776 depth, a decimal number. NAME is compared with case ignored. */
4777 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4782 strcpy (s
, XSTRING (value
)->data
);
4783 dash
= index (s
, '-');
4786 dpyinfo
->n_planes
= atoi (dash
+ 1);
4790 /* We won't find a matching visual with depth 0, so that
4791 an error will be printed below. */
4792 dpyinfo
->n_planes
= 0;
4794 /* Determine the visual class. */
4795 for (i
= 0; visual_classes
[i
].name
; ++i
)
4796 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4798 class = visual_classes
[i
].class;
4802 /* Look up a matching visual for the specified class. */
4804 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4805 dpyinfo
->n_planes
, class, &vinfo
))
4806 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4808 dpyinfo
->visual
= vinfo
.visual
;
4813 XVisualInfo
*vinfo
, vinfo_template
;
4815 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4818 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4820 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4822 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4823 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4824 &vinfo_template
, &n_visuals
);
4826 fatal ("Can't get proper X visual info");
4828 dpyinfo
->n_planes
= vinfo
->depth
;
4829 XFree ((char *) vinfo
);
4834 /* Return the X display structure for the display named NAME.
4835 Open a new connection if necessary. */
4837 struct x_display_info
*
4838 x_display_info_for_name (name
)
4842 struct x_display_info
*dpyinfo
;
4844 CHECK_STRING (name
, 0);
4846 if (! EQ (Vwindow_system
, intern ("x")))
4847 error ("Not using X Windows");
4849 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4851 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4854 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4859 /* Use this general default value to start with. */
4860 Vx_resource_name
= Vinvocation_name
;
4862 validate_x_resource_name ();
4864 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4865 (char *) XSTRING (Vx_resource_name
)->data
);
4868 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4871 XSETFASTINT (Vwindow_system_version
, 11);
4877 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4878 1, 3, 0, "Open a connection to an X server.\n\
4879 DISPLAY is the name of the display to connect to.\n\
4880 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4881 If the optional third arg MUST-SUCCEED is non-nil,\n\
4882 terminate Emacs if we can't open the connection.")
4883 (display
, xrm_string
, must_succeed
)
4884 Lisp_Object display
, xrm_string
, must_succeed
;
4886 unsigned char *xrm_option
;
4887 struct x_display_info
*dpyinfo
;
4889 CHECK_STRING (display
, 0);
4890 if (! NILP (xrm_string
))
4891 CHECK_STRING (xrm_string
, 1);
4893 if (! EQ (Vwindow_system
, intern ("x")))
4894 error ("Not using X Windows");
4896 if (! NILP (xrm_string
))
4897 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4899 xrm_option
= (unsigned char *) 0;
4901 validate_x_resource_name ();
4903 /* This is what opens the connection and sets x_current_display.
4904 This also initializes many symbols, such as those used for input. */
4905 dpyinfo
= x_term_init (display
, xrm_option
,
4906 (char *) XSTRING (Vx_resource_name
)->data
);
4910 if (!NILP (must_succeed
))
4911 fatal ("Cannot connect to X server %s.\n\
4912 Check the DISPLAY environment variable or use `-d'.\n\
4913 Also use the `xhost' program to verify that it is set to permit\n\
4914 connections from your machine.\n",
4915 XSTRING (display
)->data
);
4917 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
4922 XSETFASTINT (Vwindow_system_version
, 11);
4926 DEFUN ("x-close-connection", Fx_close_connection
,
4927 Sx_close_connection
, 1, 1, 0,
4928 "Close the connection to DISPLAY's X server.\n\
4929 For DISPLAY, specify either a frame or a display name (a string).\n\
4930 If DISPLAY is nil, that stands for the selected frame's display.")
4932 Lisp_Object display
;
4934 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4937 if (dpyinfo
->reference_count
> 0)
4938 error ("Display still has frames on it");
4941 /* Free the fonts in the font table. */
4942 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4943 if (dpyinfo
->font_table
[i
].name
)
4945 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
4946 xfree (dpyinfo
->font_table
[i
].full_name
);
4947 xfree (dpyinfo
->font_table
[i
].name
);
4948 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
4951 x_destroy_all_bitmaps (dpyinfo
);
4952 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
4954 #ifdef USE_X_TOOLKIT
4955 XtCloseDisplay (dpyinfo
->display
);
4957 XCloseDisplay (dpyinfo
->display
);
4960 x_delete_display (dpyinfo
);
4966 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4967 "Return the list of display names that Emacs has connections to.")
4970 Lisp_Object tail
, result
;
4973 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
4974 result
= Fcons (XCAR (XCAR (tail
)), result
);
4979 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4980 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4981 If ON is nil, allow buffering of requests.\n\
4982 Turning on synchronization prohibits the Xlib routines from buffering\n\
4983 requests and seriously degrades performance, but makes debugging much\n\
4985 The optional second argument DISPLAY specifies which display to act on.\n\
4986 DISPLAY should be either a frame or a display name (a string).\n\
4987 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4989 Lisp_Object display
, on
;
4991 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4993 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
4998 /* Wait for responses to all X commands issued so far for frame F. */
5005 XSync (FRAME_X_DISPLAY (f
), False
);
5010 /***********************************************************************
5012 ***********************************************************************/
5014 /* Value is the number of elements of vector VECTOR. */
5016 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5018 /* List of supported image types. Use define_image_type to add new
5019 types. Use lookup_image_type to find a type for a given symbol. */
5021 static struct image_type
*image_types
;
5023 /* The symbol `image' which is the car of the lists used to represent
5026 extern Lisp_Object Qimage
;
5028 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5034 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5035 extern Lisp_Object QCdata
;
5036 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5037 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5038 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5040 /* Other symbols. */
5042 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5044 /* Time in seconds after which images should be removed from the cache
5045 if not displayed. */
5047 Lisp_Object Vimage_cache_eviction_delay
;
5049 /* Function prototypes. */
5051 static void define_image_type
P_ ((struct image_type
*type
));
5052 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5053 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5054 static void x_laplace
P_ ((struct frame
*, struct image
*));
5055 static void x_emboss
P_ ((struct frame
*, struct image
*));
5056 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5060 /* Define a new image type from TYPE. This adds a copy of TYPE to
5061 image_types and adds the symbol *TYPE->type to Vimage_types. */
5064 define_image_type (type
)
5065 struct image_type
*type
;
5067 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5068 The initialized data segment is read-only. */
5069 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5070 bcopy (type
, p
, sizeof *p
);
5071 p
->next
= image_types
;
5073 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5077 /* Look up image type SYMBOL, and return a pointer to its image_type
5078 structure. Value is null if SYMBOL is not a known image type. */
5080 static INLINE
struct image_type
*
5081 lookup_image_type (symbol
)
5084 struct image_type
*type
;
5086 for (type
= image_types
; type
; type
= type
->next
)
5087 if (EQ (symbol
, *type
->type
))
5094 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5095 valid image specification is a list whose car is the symbol
5096 `image', and whose rest is a property list. The property list must
5097 contain a value for key `:type'. That value must be the name of a
5098 supported image type. The rest of the property list depends on the
5102 valid_image_p (object
)
5107 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5109 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5110 struct image_type
*type
= lookup_image_type (symbol
);
5113 valid_p
= type
->valid_p (object
);
5120 /* Log error message with format string FORMAT and argument ARG.
5121 Signaling an error, e.g. when an image cannot be loaded, is not a
5122 good idea because this would interrupt redisplay, and the error
5123 message display would lead to another redisplay. This function
5124 therefore simply displays a message. */
5127 image_error (format
, arg1
, arg2
)
5129 Lisp_Object arg1
, arg2
;
5131 add_to_log (format
, arg1
, arg2
);
5136 /***********************************************************************
5137 Image specifications
5138 ***********************************************************************/
5140 enum image_value_type
5142 IMAGE_DONT_CHECK_VALUE_TYPE
,
5145 IMAGE_POSITIVE_INTEGER_VALUE
,
5146 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5148 IMAGE_INTEGER_VALUE
,
5149 IMAGE_FUNCTION_VALUE
,
5154 /* Structure used when parsing image specifications. */
5156 struct image_keyword
5158 /* Name of keyword. */
5161 /* The type of value allowed. */
5162 enum image_value_type type
;
5164 /* Non-zero means key must be present. */
5167 /* Used to recognize duplicate keywords in a property list. */
5170 /* The value that was found. */
5175 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5177 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5180 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5181 has the format (image KEYWORD VALUE ...). One of the keyword/
5182 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5183 image_keywords structures of size NKEYWORDS describing other
5184 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5187 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5189 struct image_keyword
*keywords
;
5196 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5199 plist
= XCDR (spec
);
5200 while (CONSP (plist
))
5202 Lisp_Object key
, value
;
5204 /* First element of a pair must be a symbol. */
5206 plist
= XCDR (plist
);
5210 /* There must follow a value. */
5213 value
= XCAR (plist
);
5214 plist
= XCDR (plist
);
5216 /* Find key in KEYWORDS. Error if not found. */
5217 for (i
= 0; i
< nkeywords
; ++i
)
5218 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5224 /* Record that we recognized the keyword. If a keywords
5225 was found more than once, it's an error. */
5226 keywords
[i
].value
= value
;
5227 ++keywords
[i
].count
;
5229 if (keywords
[i
].count
> 1)
5232 /* Check type of value against allowed type. */
5233 switch (keywords
[i
].type
)
5235 case IMAGE_STRING_VALUE
:
5236 if (!STRINGP (value
))
5240 case IMAGE_SYMBOL_VALUE
:
5241 if (!SYMBOLP (value
))
5245 case IMAGE_POSITIVE_INTEGER_VALUE
:
5246 if (!INTEGERP (value
) || XINT (value
) <= 0)
5250 case IMAGE_ASCENT_VALUE
:
5251 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5253 else if (INTEGERP (value
)
5254 && XINT (value
) >= 0
5255 && XINT (value
) <= 100)
5259 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5260 if (!INTEGERP (value
) || XINT (value
) < 0)
5264 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5267 case IMAGE_FUNCTION_VALUE
:
5268 value
= indirect_function (value
);
5270 || COMPILEDP (value
)
5271 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5275 case IMAGE_NUMBER_VALUE
:
5276 if (!INTEGERP (value
) && !FLOATP (value
))
5280 case IMAGE_INTEGER_VALUE
:
5281 if (!INTEGERP (value
))
5285 case IMAGE_BOOL_VALUE
:
5286 if (!NILP (value
) && !EQ (value
, Qt
))
5295 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5299 /* Check that all mandatory fields are present. */
5300 for (i
= 0; i
< nkeywords
; ++i
)
5301 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5304 return NILP (plist
);
5308 /* Return the value of KEY in image specification SPEC. Value is nil
5309 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5310 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5313 image_spec_value (spec
, key
, found
)
5314 Lisp_Object spec
, key
;
5319 xassert (valid_image_p (spec
));
5321 for (tail
= XCDR (spec
);
5322 CONSP (tail
) && CONSP (XCDR (tail
));
5323 tail
= XCDR (XCDR (tail
)))
5325 if (EQ (XCAR (tail
), key
))
5329 return XCAR (XCDR (tail
));
5339 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5340 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5341 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5342 size in canonical character units.\n\
5343 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5344 or omitted means use the selected frame.")
5345 (spec
, pixels
, frame
)
5346 Lisp_Object spec
, pixels
, frame
;
5351 if (valid_image_p (spec
))
5353 struct frame
*f
= check_x_frame (frame
);
5354 int id
= lookup_image (f
, spec
);
5355 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5356 int width
= img
->width
+ 2 * img
->margin
;
5357 int height
= img
->height
+ 2 * img
->margin
;
5360 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5361 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5363 size
= Fcons (make_number (width
), make_number (height
));
5366 error ("Invalid image specification");
5373 /***********************************************************************
5374 Image type independent image structures
5375 ***********************************************************************/
5377 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5378 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5381 /* Allocate and return a new image structure for image specification
5382 SPEC. SPEC has a hash value of HASH. */
5384 static struct image
*
5385 make_image (spec
, hash
)
5389 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5391 xassert (valid_image_p (spec
));
5392 bzero (img
, sizeof *img
);
5393 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5394 xassert (img
->type
!= NULL
);
5396 img
->data
.lisp_val
= Qnil
;
5397 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5403 /* Free image IMG which was used on frame F, including its resources. */
5412 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5414 /* Remove IMG from the hash table of its cache. */
5416 img
->prev
->next
= img
->next
;
5418 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5421 img
->next
->prev
= img
->prev
;
5423 c
->images
[img
->id
] = NULL
;
5425 /* Free resources, then free IMG. */
5426 img
->type
->free (f
, img
);
5432 /* Prepare image IMG for display on frame F. Must be called before
5433 drawing an image. */
5436 prepare_image_for_display (f
, img
)
5442 /* We're about to display IMG, so set its timestamp to `now'. */
5444 img
->timestamp
= EMACS_SECS (t
);
5446 /* If IMG doesn't have a pixmap yet, load it now, using the image
5447 type dependent loader function. */
5448 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5449 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5453 /* Value is the number of pixels for the ascent of image IMG when
5454 drawn in face FACE. */
5457 image_ascent (img
, face
)
5461 int height
= img
->height
+ img
->margin
;
5464 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5467 ascent
= height
/ 2 - (face
->font
->descent
- face
->font
->ascent
) / 2;
5469 ascent
= height
/ 2;
5472 ascent
= height
* img
->ascent
/ 100.0;
5479 /***********************************************************************
5480 Helper functions for X image types
5481 ***********************************************************************/
5483 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5484 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5486 Lisp_Object color_name
,
5487 unsigned long dflt
));
5489 /* Free X resources of image IMG which is used on frame F. */
5492 x_clear_image (f
, img
)
5499 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5507 x_free_colors (f
, img
->colors
, img
->ncolors
);
5510 xfree (img
->colors
);
5517 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5518 cannot be allocated, use DFLT. Add a newly allocated color to
5519 IMG->colors, so that it can be freed again. Value is the pixel
5522 static unsigned long
5523 x_alloc_image_color (f
, img
, color_name
, dflt
)
5526 Lisp_Object color_name
;
5530 unsigned long result
;
5532 xassert (STRINGP (color_name
));
5534 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5536 /* This isn't called frequently so we get away with simply
5537 reallocating the color vector to the needed size, here. */
5540 (unsigned long *) xrealloc (img
->colors
,
5541 img
->ncolors
* sizeof *img
->colors
);
5542 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5543 result
= color
.pixel
;
5553 /***********************************************************************
5555 ***********************************************************************/
5557 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5560 /* Return a new, initialized image cache that is allocated from the
5561 heap. Call free_image_cache to free an image cache. */
5563 struct image_cache
*
5566 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5569 bzero (c
, sizeof *c
);
5571 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5572 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5573 c
->buckets
= (struct image
**) xmalloc (size
);
5574 bzero (c
->buckets
, size
);
5579 /* Free image cache of frame F. Be aware that X frames share images
5583 free_image_cache (f
)
5586 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5591 /* Cache should not be referenced by any frame when freed. */
5592 xassert (c
->refcount
== 0);
5594 for (i
= 0; i
< c
->used
; ++i
)
5595 free_image (f
, c
->images
[i
]);
5599 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5604 /* Clear image cache of frame F. FORCE_P non-zero means free all
5605 images. FORCE_P zero means clear only images that haven't been
5606 displayed for some time. Should be called from time to time to
5607 reduce the number of loaded images. If image-eviction-seconds is
5608 non-nil, this frees images in the cache which weren't displayed for
5609 at least that many seconds. */
5612 clear_image_cache (f
, force_p
)
5616 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5618 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5622 int i
, any_freed_p
= 0;
5625 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5627 for (i
= 0; i
< c
->used
; ++i
)
5629 struct image
*img
= c
->images
[i
];
5632 || (img
->timestamp
> old
)))
5634 free_image (f
, img
);
5639 /* We may be clearing the image cache because, for example,
5640 Emacs was iconified for a longer period of time. In that
5641 case, current matrices may still contain references to
5642 images freed above. So, clear these matrices. */
5645 clear_current_matrices (f
);
5646 ++windows_or_buffers_changed
;
5652 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5654 "Clear the image cache of FRAME.\n\
5655 FRAME nil or omitted means use the selected frame.\n\
5656 FRAME t means clear the image caches of all frames.")
5664 FOR_EACH_FRAME (tail
, frame
)
5665 if (FRAME_X_P (XFRAME (frame
)))
5666 clear_image_cache (XFRAME (frame
), 1);
5669 clear_image_cache (check_x_frame (frame
), 1);
5675 /* Return the id of image with Lisp specification SPEC on frame F.
5676 SPEC must be a valid Lisp image specification (see valid_image_p). */
5679 lookup_image (f
, spec
)
5683 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5687 struct gcpro gcpro1
;
5690 /* F must be a window-system frame, and SPEC must be a valid image
5692 xassert (FRAME_WINDOW_P (f
));
5693 xassert (valid_image_p (spec
));
5697 /* Look up SPEC in the hash table of the image cache. */
5698 hash
= sxhash (spec
, 0);
5699 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5701 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5702 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5705 /* If not found, create a new image and cache it. */
5708 img
= make_image (spec
, hash
);
5709 cache_image (f
, img
);
5710 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5711 xassert (!interrupt_input_blocked
);
5713 /* If we can't load the image, and we don't have a width and
5714 height, use some arbitrary width and height so that we can
5715 draw a rectangle for it. */
5716 if (img
->load_failed_p
)
5720 value
= image_spec_value (spec
, QCwidth
, NULL
);
5721 img
->width
= (INTEGERP (value
)
5722 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5723 value
= image_spec_value (spec
, QCheight
, NULL
);
5724 img
->height
= (INTEGERP (value
)
5725 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5729 /* Handle image type independent image attributes
5730 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5731 Lisp_Object ascent
, margin
, relief
, algorithm
;
5734 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5735 if (INTEGERP (ascent
))
5736 img
->ascent
= XFASTINT (ascent
);
5737 else if (EQ (ascent
, Qcenter
))
5738 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5740 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5741 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5742 img
->margin
= XFASTINT (margin
);
5744 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5745 if (INTEGERP (relief
))
5747 img
->relief
= XINT (relief
);
5748 img
->margin
+= abs (img
->relief
);
5751 /* Should we apply an image transformation algorithm? */
5752 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5755 if (EQ (algorithm
, Qlaplace
))
5757 else if (EQ (algorithm
, Qemboss
))
5759 else if (CONSP (algorithm
)
5760 && EQ (XCAR (algorithm
), Qedge_detection
))
5763 tem
= XCDR (algorithm
);
5765 x_edge_detection (f
, img
,
5766 Fplist_get (tem
, QCmatrix
),
5767 Fplist_get (tem
, QCcolor_adjustment
));
5771 /* Manipulation of the image's mask. */
5774 /* `:heuristic-mask t'
5776 means build a mask heuristically.
5777 `:heuristic-mask (R G B)'
5778 `:mask (heuristic (R G B))'
5779 measn build a mask from color (R G B) in the
5782 means remove a mask, if any. */
5786 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5788 x_build_heuristic_mask (f
, img
, mask
);
5793 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5795 if (EQ (mask
, Qheuristic
))
5796 x_build_heuristic_mask (f
, img
, Qt
);
5797 else if (CONSP (mask
)
5798 && EQ (XCAR (mask
), Qheuristic
))
5800 if (CONSP (XCDR (mask
)))
5801 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5803 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5805 else if (NILP (mask
) && found_p
&& img
->mask
)
5808 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5817 /* We're using IMG, so set its timestamp to `now'. */
5818 EMACS_GET_TIME (now
);
5819 img
->timestamp
= EMACS_SECS (now
);
5823 /* Value is the image id. */
5828 /* Cache image IMG in the image cache of frame F. */
5831 cache_image (f
, img
)
5835 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5838 /* Find a free slot in c->images. */
5839 for (i
= 0; i
< c
->used
; ++i
)
5840 if (c
->images
[i
] == NULL
)
5843 /* If no free slot found, maybe enlarge c->images. */
5844 if (i
== c
->used
&& c
->used
== c
->size
)
5847 c
->images
= (struct image
**) xrealloc (c
->images
,
5848 c
->size
* sizeof *c
->images
);
5851 /* Add IMG to c->images, and assign IMG an id. */
5857 /* Add IMG to the cache's hash table. */
5858 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5859 img
->next
= c
->buckets
[i
];
5861 img
->next
->prev
= img
;
5863 c
->buckets
[i
] = img
;
5867 /* Call FN on every image in the image cache of frame F. Used to mark
5868 Lisp Objects in the image cache. */
5871 forall_images_in_image_cache (f
, fn
)
5873 void (*fn
) P_ ((struct image
*img
));
5875 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
5877 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5881 for (i
= 0; i
< c
->used
; ++i
)
5890 /***********************************************************************
5892 ***********************************************************************/
5894 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
5895 XImage
**, Pixmap
*));
5896 static void x_destroy_x_image
P_ ((XImage
*));
5897 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
5900 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
5901 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
5902 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
5903 via xmalloc. Print error messages via image_error if an error
5904 occurs. Value is non-zero if successful. */
5907 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
5909 int width
, height
, depth
;
5913 Display
*display
= FRAME_X_DISPLAY (f
);
5914 Screen
*screen
= FRAME_X_SCREEN (f
);
5915 Window window
= FRAME_X_WINDOW (f
);
5917 xassert (interrupt_input_blocked
);
5920 depth
= DefaultDepthOfScreen (screen
);
5921 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
5922 depth
, ZPixmap
, 0, NULL
, width
, height
,
5923 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
5926 image_error ("Unable to allocate X image", Qnil
, Qnil
);
5930 /* Allocate image raster. */
5931 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
5933 /* Allocate a pixmap of the same size. */
5934 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
5937 x_destroy_x_image (*ximg
);
5939 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
5947 /* Destroy XImage XIMG. Free XIMG->data. */
5950 x_destroy_x_image (ximg
)
5953 xassert (interrupt_input_blocked
);
5958 XDestroyImage (ximg
);
5963 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
5964 are width and height of both the image and pixmap. */
5967 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
5974 xassert (interrupt_input_blocked
);
5975 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
5976 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
5977 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
5982 /***********************************************************************
5984 ***********************************************************************/
5986 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
5987 static char *slurp_file
P_ ((char *, int *));
5990 /* Find image file FILE. Look in data-directory, then
5991 x-bitmap-file-path. Value is the full name of the file found, or
5992 nil if not found. */
5995 x_find_image_file (file
)
5998 Lisp_Object file_found
, search_path
;
5999 struct gcpro gcpro1
, gcpro2
;
6003 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6004 GCPRO2 (file_found
, search_path
);
6006 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6007 fd
= openp (search_path
, file
, "", &file_found
, 0);
6019 /* Read FILE into memory. Value is a pointer to a buffer allocated
6020 with xmalloc holding FILE's contents. Value is null if an error
6021 occured. *SIZE is set to the size of the file. */
6024 slurp_file (file
, size
)
6032 if (stat (file
, &st
) == 0
6033 && (fp
= fopen (file
, "r")) != NULL
6034 && (buf
= (char *) xmalloc (st
.st_size
),
6035 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6056 /***********************************************************************
6058 ***********************************************************************/
6060 static int xbm_scan
P_ ((char **, char *, char *, int *));
6061 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6062 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6064 static int xbm_image_p
P_ ((Lisp_Object object
));
6065 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6067 static int xbm_file_p
P_ ((Lisp_Object
));
6070 /* Indices of image specification fields in xbm_format, below. */
6072 enum xbm_keyword_index
6090 /* Vector of image_keyword structures describing the format
6091 of valid XBM image specifications. */
6093 static struct image_keyword xbm_format
[XBM_LAST
] =
6095 {":type", IMAGE_SYMBOL_VALUE
, 1},
6096 {":file", IMAGE_STRING_VALUE
, 0},
6097 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6098 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6099 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6100 {":foreground", IMAGE_STRING_VALUE
, 0},
6101 {":background", IMAGE_STRING_VALUE
, 0},
6102 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6103 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6104 {":relief", IMAGE_INTEGER_VALUE
, 0},
6105 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6106 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6107 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6110 /* Structure describing the image type XBM. */
6112 static struct image_type xbm_type
=
6121 /* Tokens returned from xbm_scan. */
6130 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6131 A valid specification is a list starting with the symbol `image'
6132 The rest of the list is a property list which must contain an
6135 If the specification specifies a file to load, it must contain
6136 an entry `:file FILENAME' where FILENAME is a string.
6138 If the specification is for a bitmap loaded from memory it must
6139 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6140 WIDTH and HEIGHT are integers > 0. DATA may be:
6142 1. a string large enough to hold the bitmap data, i.e. it must
6143 have a size >= (WIDTH + 7) / 8 * HEIGHT
6145 2. a bool-vector of size >= WIDTH * HEIGHT
6147 3. a vector of strings or bool-vectors, one for each line of the
6150 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6151 may not be specified in this case because they are defined in the
6154 Both the file and data forms may contain the additional entries
6155 `:background COLOR' and `:foreground COLOR'. If not present,
6156 foreground and background of the frame on which the image is
6157 displayed is used. */
6160 xbm_image_p (object
)
6163 struct image_keyword kw
[XBM_LAST
];
6165 bcopy (xbm_format
, kw
, sizeof kw
);
6166 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6169 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6171 if (kw
[XBM_FILE
].count
)
6173 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6176 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6178 /* In-memory XBM file. */
6179 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6187 /* Entries for `:width', `:height' and `:data' must be present. */
6188 if (!kw
[XBM_WIDTH
].count
6189 || !kw
[XBM_HEIGHT
].count
6190 || !kw
[XBM_DATA
].count
)
6193 data
= kw
[XBM_DATA
].value
;
6194 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6195 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6197 /* Check type of data, and width and height against contents of
6203 /* Number of elements of the vector must be >= height. */
6204 if (XVECTOR (data
)->size
< height
)
6207 /* Each string or bool-vector in data must be large enough
6208 for one line of the image. */
6209 for (i
= 0; i
< height
; ++i
)
6211 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6215 if (XSTRING (elt
)->size
6216 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6219 else if (BOOL_VECTOR_P (elt
))
6221 if (XBOOL_VECTOR (elt
)->size
< width
)
6228 else if (STRINGP (data
))
6230 if (XSTRING (data
)->size
6231 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6234 else if (BOOL_VECTOR_P (data
))
6236 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6247 /* Scan a bitmap file. FP is the stream to read from. Value is
6248 either an enumerator from enum xbm_token, or a character for a
6249 single-character token, or 0 at end of file. If scanning an
6250 identifier, store the lexeme of the identifier in SVAL. If
6251 scanning a number, store its value in *IVAL. */
6254 xbm_scan (s
, end
, sval
, ival
)
6261 /* Skip white space. */
6262 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6267 else if (isdigit (c
))
6269 int value
= 0, digit
;
6271 if (c
== '0' && *s
< end
)
6274 if (c
== 'x' || c
== 'X')
6281 else if (c
>= 'a' && c
<= 'f')
6282 digit
= c
- 'a' + 10;
6283 else if (c
>= 'A' && c
<= 'F')
6284 digit
= c
- 'A' + 10;
6287 value
= 16 * value
+ digit
;
6290 else if (isdigit (c
))
6294 && (c
= *(*s
)++, isdigit (c
)))
6295 value
= 8 * value
+ c
- '0';
6302 && (c
= *(*s
)++, isdigit (c
)))
6303 value
= 10 * value
+ c
- '0';
6311 else if (isalpha (c
) || c
== '_')
6315 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6327 /* Replacement for XReadBitmapFileData which isn't available under old
6328 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6329 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6330 the image. Return in *DATA the bitmap data allocated with xmalloc.
6331 Value is non-zero if successful. DATA null means just test if
6332 CONTENTS looks like an im-memory XBM file. */
6335 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6336 char *contents
, *end
;
6337 int *width
, *height
;
6338 unsigned char **data
;
6341 char buffer
[BUFSIZ
];
6344 int bytes_per_line
, i
, nbytes
;
6350 LA1 = xbm_scan (&s, end, buffer, &value)
6352 #define expect(TOKEN) \
6353 if (LA1 != (TOKEN)) \
6358 #define expect_ident(IDENT) \
6359 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6364 *width
= *height
= -1;
6367 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6369 /* Parse defines for width, height and hot-spots. */
6373 expect_ident ("define");
6374 expect (XBM_TK_IDENT
);
6376 if (LA1
== XBM_TK_NUMBER
);
6378 char *p
= strrchr (buffer
, '_');
6379 p
= p
? p
+ 1 : buffer
;
6380 if (strcmp (p
, "width") == 0)
6382 else if (strcmp (p
, "height") == 0)
6385 expect (XBM_TK_NUMBER
);
6388 if (*width
< 0 || *height
< 0)
6390 else if (data
== NULL
)
6393 /* Parse bits. Must start with `static'. */
6394 expect_ident ("static");
6395 if (LA1
== XBM_TK_IDENT
)
6397 if (strcmp (buffer
, "unsigned") == 0)
6400 expect_ident ("char");
6402 else if (strcmp (buffer
, "short") == 0)
6406 if (*width
% 16 && *width
% 16 < 9)
6409 else if (strcmp (buffer
, "char") == 0)
6417 expect (XBM_TK_IDENT
);
6423 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6424 nbytes
= bytes_per_line
* *height
;
6425 p
= *data
= (char *) xmalloc (nbytes
);
6429 for (i
= 0; i
< nbytes
; i
+= 2)
6432 expect (XBM_TK_NUMBER
);
6435 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6438 if (LA1
== ',' || LA1
== '}')
6446 for (i
= 0; i
< nbytes
; ++i
)
6449 expect (XBM_TK_NUMBER
);
6453 if (LA1
== ',' || LA1
== '}')
6478 /* Load XBM image IMG which will be displayed on frame F from buffer
6479 CONTENTS. END is the end of the buffer. Value is non-zero if
6483 xbm_load_image (f
, img
, contents
, end
)
6486 char *contents
, *end
;
6489 unsigned char *data
;
6492 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6495 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6496 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6497 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6500 xassert (img
->width
> 0 && img
->height
> 0);
6502 /* Get foreground and background colors, maybe allocate colors. */
6503 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6505 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6507 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6509 background
= x_alloc_image_color (f
, img
, value
, background
);
6513 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6516 img
->width
, img
->height
,
6517 foreground
, background
,
6521 if (img
->pixmap
== 0)
6523 x_clear_image (f
, img
);
6524 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6532 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6538 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6545 return (STRINGP (data
)
6546 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6547 (XSTRING (data
)->data
6548 + STRING_BYTES (XSTRING (data
))),
6553 /* Fill image IMG which is used on frame F with pixmap data. Value is
6554 non-zero if successful. */
6562 Lisp_Object file_name
;
6564 xassert (xbm_image_p (img
->spec
));
6566 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6567 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6568 if (STRINGP (file_name
))
6573 struct gcpro gcpro1
;
6575 file
= x_find_image_file (file_name
);
6577 if (!STRINGP (file
))
6579 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6584 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6585 if (contents
== NULL
)
6587 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6592 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6597 struct image_keyword fmt
[XBM_LAST
];
6599 unsigned char *bitmap_data
;
6601 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6602 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6604 int parsed_p
, height
, width
;
6605 int in_memory_file_p
= 0;
6607 /* See if data looks like an in-memory XBM file. */
6608 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6609 in_memory_file_p
= xbm_file_p (data
);
6611 /* Parse the image specification. */
6612 bcopy (xbm_format
, fmt
, sizeof fmt
);
6613 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6616 /* Get specified width, and height. */
6617 if (!in_memory_file_p
)
6619 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6620 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6621 xassert (img
->width
> 0 && img
->height
> 0);
6626 /* Get foreground and background colors, maybe allocate colors. */
6627 if (fmt
[XBM_FOREGROUND
].count
)
6628 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6630 if (fmt
[XBM_BACKGROUND
].count
)
6631 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6634 if (in_memory_file_p
)
6635 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6636 (XSTRING (data
)->data
6637 + STRING_BYTES (XSTRING (data
))));
6644 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6646 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6647 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6649 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6651 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6653 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6656 else if (STRINGP (data
))
6657 bits
= XSTRING (data
)->data
;
6659 bits
= XBOOL_VECTOR (data
)->data
;
6661 /* Create the pixmap. */
6662 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6664 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6667 img
->width
, img
->height
,
6668 foreground
, background
,
6674 image_error ("Unable to create pixmap for XBM image `%s'",
6676 x_clear_image (f
, img
);
6688 /***********************************************************************
6690 ***********************************************************************/
6694 static int xpm_image_p
P_ ((Lisp_Object object
));
6695 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6696 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6698 #include "X11/xpm.h"
6700 /* The symbol `xpm' identifying XPM-format images. */
6704 /* Indices of image specification fields in xpm_format, below. */
6706 enum xpm_keyword_index
6721 /* Vector of image_keyword structures describing the format
6722 of valid XPM image specifications. */
6724 static struct image_keyword xpm_format
[XPM_LAST
] =
6726 {":type", IMAGE_SYMBOL_VALUE
, 1},
6727 {":file", IMAGE_STRING_VALUE
, 0},
6728 {":data", IMAGE_STRING_VALUE
, 0},
6729 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6730 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6731 {":relief", IMAGE_INTEGER_VALUE
, 0},
6732 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6733 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6734 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6735 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6738 /* Structure describing the image type XBM. */
6740 static struct image_type xpm_type
=
6750 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6751 for XPM images. Such a list must consist of conses whose car and
6755 xpm_valid_color_symbols_p (color_symbols
)
6756 Lisp_Object color_symbols
;
6758 while (CONSP (color_symbols
))
6760 Lisp_Object sym
= XCAR (color_symbols
);
6762 || !STRINGP (XCAR (sym
))
6763 || !STRINGP (XCDR (sym
)))
6765 color_symbols
= XCDR (color_symbols
);
6768 return NILP (color_symbols
);
6772 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6775 xpm_image_p (object
)
6778 struct image_keyword fmt
[XPM_LAST
];
6779 bcopy (xpm_format
, fmt
, sizeof fmt
);
6780 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6781 /* Either `:file' or `:data' must be present. */
6782 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6783 /* Either no `:color-symbols' or it's a list of conses
6784 whose car and cdr are strings. */
6785 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6786 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
6790 /* Load image IMG which will be displayed on frame F. Value is
6791 non-zero if successful. */
6799 XpmAttributes attrs
;
6800 Lisp_Object specified_file
, color_symbols
;
6802 /* Configure the XPM lib. Use the visual of frame F. Allocate
6803 close colors. Return colors allocated. */
6804 bzero (&attrs
, sizeof attrs
);
6805 attrs
.visual
= FRAME_X_VISUAL (f
);
6806 attrs
.colormap
= FRAME_X_COLORMAP (f
);
6807 attrs
.valuemask
|= XpmVisual
;
6808 attrs
.valuemask
|= XpmColormap
;
6809 attrs
.valuemask
|= XpmReturnAllocPixels
;
6810 #ifdef XpmAllocCloseColors
6811 attrs
.alloc_close_colors
= 1;
6812 attrs
.valuemask
|= XpmAllocCloseColors
;
6814 attrs
.closeness
= 600;
6815 attrs
.valuemask
|= XpmCloseness
;
6818 /* If image specification contains symbolic color definitions, add
6819 these to `attrs'. */
6820 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
6821 if (CONSP (color_symbols
))
6824 XpmColorSymbol
*xpm_syms
;
6827 attrs
.valuemask
|= XpmColorSymbols
;
6829 /* Count number of symbols. */
6830 attrs
.numsymbols
= 0;
6831 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
6834 /* Allocate an XpmColorSymbol array. */
6835 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
6836 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
6837 bzero (xpm_syms
, size
);
6838 attrs
.colorsymbols
= xpm_syms
;
6840 /* Fill the color symbol array. */
6841 for (tail
= color_symbols
, i
= 0;
6843 ++i
, tail
= XCDR (tail
))
6845 Lisp_Object name
= XCAR (XCAR (tail
));
6846 Lisp_Object color
= XCDR (XCAR (tail
));
6847 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
6848 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
6849 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
6850 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
6854 /* Create a pixmap for the image, either from a file, or from a
6855 string buffer containing data in the same format as an XPM file. */
6857 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
6858 if (STRINGP (specified_file
))
6860 Lisp_Object file
= x_find_image_file (specified_file
);
6861 if (!STRINGP (file
))
6863 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6868 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6869 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
6874 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
6875 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
6876 XSTRING (buffer
)->data
,
6877 &img
->pixmap
, &img
->mask
,
6882 if (rc
== XpmSuccess
)
6884 /* Remember allocated colors. */
6885 img
->ncolors
= attrs
.nalloc_pixels
;
6886 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
6887 * sizeof *img
->colors
);
6888 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
6890 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
6891 #ifdef DEBUG_X_COLORS
6892 register_color (img
->colors
[i
]);
6896 img
->width
= attrs
.width
;
6897 img
->height
= attrs
.height
;
6898 xassert (img
->width
> 0 && img
->height
> 0);
6900 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
6902 XpmFreeAttributes (&attrs
);
6910 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
6913 case XpmFileInvalid
:
6914 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
6918 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
6921 case XpmColorFailed
:
6922 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
6926 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
6931 return rc
== XpmSuccess
;
6934 #endif /* HAVE_XPM != 0 */
6937 /***********************************************************************
6939 ***********************************************************************/
6941 /* An entry in the color table mapping an RGB color to a pixel color. */
6946 unsigned long pixel
;
6948 /* Next in color table collision list. */
6949 struct ct_color
*next
;
6952 /* The bucket vector size to use. Must be prime. */
6956 /* Value is a hash of the RGB color given by R, G, and B. */
6958 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
6960 /* The color hash table. */
6962 struct ct_color
**ct_table
;
6964 /* Number of entries in the color table. */
6966 int ct_colors_allocated
;
6968 /* Function prototypes. */
6970 static void init_color_table
P_ ((void));
6971 static void free_color_table
P_ ((void));
6972 static unsigned long *colors_in_color_table
P_ ((int *n
));
6973 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
6974 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
6977 /* Initialize the color table. */
6982 int size
= CT_SIZE
* sizeof (*ct_table
);
6983 ct_table
= (struct ct_color
**) xmalloc (size
);
6984 bzero (ct_table
, size
);
6985 ct_colors_allocated
= 0;
6989 /* Free memory associated with the color table. */
6995 struct ct_color
*p
, *next
;
6997 for (i
= 0; i
< CT_SIZE
; ++i
)
6998 for (p
= ct_table
[i
]; p
; p
= next
)
7009 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7010 entry for that color already is in the color table, return the
7011 pixel color of that entry. Otherwise, allocate a new color for R,
7012 G, B, and make an entry in the color table. */
7014 static unsigned long
7015 lookup_rgb_color (f
, r
, g
, b
)
7019 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7020 int i
= hash
% CT_SIZE
;
7023 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7024 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7038 cmap
= FRAME_X_COLORMAP (f
);
7039 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7044 ++ct_colors_allocated
;
7046 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7050 p
->pixel
= color
.pixel
;
7051 p
->next
= ct_table
[i
];
7055 return FRAME_FOREGROUND_PIXEL (f
);
7062 /* Look up pixel color PIXEL which is used on frame F in the color
7063 table. If not already present, allocate it. Value is PIXEL. */
7065 static unsigned long
7066 lookup_pixel_color (f
, pixel
)
7068 unsigned long pixel
;
7070 int i
= pixel
% CT_SIZE
;
7073 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7074 if (p
->pixel
== pixel
)
7085 cmap
= FRAME_X_COLORMAP (f
);
7086 color
.pixel
= pixel
;
7087 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7088 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7093 ++ct_colors_allocated
;
7095 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7100 p
->next
= ct_table
[i
];
7104 return FRAME_FOREGROUND_PIXEL (f
);
7111 /* Value is a vector of all pixel colors contained in the color table,
7112 allocated via xmalloc. Set *N to the number of colors. */
7114 static unsigned long *
7115 colors_in_color_table (n
)
7120 unsigned long *colors
;
7122 if (ct_colors_allocated
== 0)
7129 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7131 *n
= ct_colors_allocated
;
7133 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7134 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7135 colors
[j
++] = p
->pixel
;
7143 /***********************************************************************
7145 ***********************************************************************/
7147 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7148 int, XImage
*, int));
7149 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7150 XColor
*, int, XImage
*, int));
7151 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7152 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7153 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7155 /* Edge detection matrices for different edge-detection
7158 static int emboss_matrix
[9] = {
7160 2, -1, 0, /* y - 1 */
7162 0, 1, -2 /* y + 1 */
7165 static int laplace_matrix
[9] = {
7167 1, 0, 0, /* y - 1 */
7169 0, 0, -1 /* y + 1 */
7173 /* On frame F, return an array of XColor structures describing image
7174 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7175 non-zero means also fill the red/green/blue members of the XColor
7176 structures. Value is a pointer to the array of XColors structures,
7177 allocated with xmalloc; it must be freed by the caller. */
7180 x_to_xcolors (f
, img
, rgb_p
)
7191 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7193 /* Get the X image IMG->pixmap. */
7194 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7195 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7197 /* Fill the `pixel' members of the XColor array. I wished there
7198 were an easy and portable way to circumvent XGetPixel. */
7200 for (y
= 0; y
< img
->height
; ++y
)
7204 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7205 p
->pixel
= XGetPixel (ximg
, x
, y
);
7208 XQueryColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7212 XDestroyImage (ximg
);
7219 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7220 RGB members are set. F is the frame on which this all happens.
7221 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7224 x_from_xcolors (f
, img
, colors
)
7235 init_color_table ();
7237 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7240 for (y
= 0; y
< img
->height
; ++y
)
7241 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7243 unsigned long pixel
;
7244 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7245 XPutPixel (oimg
, x
, y
, pixel
);
7249 x_clear_image (f
, img
);
7251 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7252 x_destroy_x_image (oimg
);
7253 img
->pixmap
= pixmap
;
7254 img
->colors
= colors_in_color_table (&img
->ncolors
);
7255 free_color_table ();
7260 /* On frame F, perform edge-detection on image IMG.
7262 MATRIX is a nine-element array specifying the transformation
7263 matrix. See emboss_matrix for an example.
7265 COLOR_ADJUST is a color adjustment added to each pixel of the
7269 x_detect_edges (f
, img
, matrix
, color_adjust
)
7272 int matrix
[9], color_adjust
;
7274 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7278 for (i
= sum
= 0; i
< 9; ++i
)
7279 sum
+= abs (matrix
[i
]);
7281 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7283 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7285 for (y
= 0; y
< img
->height
; ++y
)
7287 p
= COLOR (new, 0, y
);
7288 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7289 p
= COLOR (new, img
->width
- 1, y
);
7290 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7293 for (x
= 1; x
< img
->width
- 1; ++x
)
7295 p
= COLOR (new, x
, 0);
7296 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7297 p
= COLOR (new, x
, img
->height
- 1);
7298 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7301 for (y
= 1; y
< img
->height
- 1; ++y
)
7303 p
= COLOR (new, 1, y
);
7305 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7307 int r
, g
, b
, intensity
, y1
, x1
;
7310 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7311 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7314 XColor
*t
= COLOR (colors
, x1
, y1
);
7315 r
+= matrix
[i
] * t
->red
;
7316 g
+= matrix
[i
] * t
->green
;
7317 b
+= matrix
[i
] * t
->blue
;
7320 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7321 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7322 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7324 intensity
= (2 * r
+ 3 * g
+ b
) / 6;
7325 p
->red
= p
->green
= p
->blue
= intensity
;
7330 x_from_xcolors (f
, img
, new);
7336 /* Perform the pre-defined `emboss' edge-detection on image IMG
7344 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7348 /* Perform the pre-defined `laplace' edge-detection on image IMG
7356 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7360 /* Perform edge-detection on image IMG on frame F, with specified
7361 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7363 MATRIX must be either
7365 - a list of at least 9 numbers in row-major form
7366 - a vector of at least 9 numbers
7368 COLOR_ADJUST nil means use a default; otherwise it must be a
7372 x_edge_detection (f
, img
, matrix
, color_adjust
)
7375 Lisp_Object matrix
, color_adjust
;
7383 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7384 ++i
, matrix
= XCDR (matrix
))
7385 trans
[i
] = XFLOATINT (XCAR (matrix
));
7387 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7389 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7390 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7393 if (NILP (color_adjust
))
7394 color_adjust
= make_number (0xffff / 2);
7396 if (i
== 9 && NUMBERP (color_adjust
))
7397 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7401 /* Build a mask for image IMG which is used on frame F. FILE is the
7402 name of an image file, for error messages. HOW determines how to
7403 determine the background color of IMG. If it is a list '(R G B)',
7404 with R, G, and B being integers >= 0, take that as the color of the
7405 background. Otherwise, determine the background color of IMG
7406 heuristically. Value is non-zero if successful. */
7409 x_build_heuristic_mask (f
, img
, how
)
7414 Display
*dpy
= FRAME_X_DISPLAY (f
);
7415 XImage
*ximg
, *mask_img
;
7416 int x
, y
, rc
, look_at_corners_p
;
7417 unsigned long bg
= 0;
7423 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7427 /* Create an image and pixmap serving as mask. */
7428 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7429 &mask_img
, &img
->mask
);
7436 /* Get the X image of IMG->pixmap. */
7437 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7440 /* Determine the background color of ximg. If HOW is `(R G B)'
7441 take that as color. Otherwise, try to determine the color
7443 look_at_corners_p
= 1;
7451 && NATNUMP (XCAR (how
)))
7453 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7457 if (i
== 3 && NILP (how
))
7459 char color_name
[30];
7460 XColor exact
, color
;
7463 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7465 cmap
= FRAME_X_COLORMAP (f
);
7466 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7469 look_at_corners_p
= 0;
7474 if (look_at_corners_p
)
7476 unsigned long corners
[4];
7479 /* Get the colors at the corners of ximg. */
7480 corners
[0] = XGetPixel (ximg
, 0, 0);
7481 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7482 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7483 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7485 /* Choose the most frequently found color as background. */
7486 for (i
= best_count
= 0; i
< 4; ++i
)
7490 for (j
= n
= 0; j
< 4; ++j
)
7491 if (corners
[i
] == corners
[j
])
7495 bg
= corners
[i
], best_count
= n
;
7499 /* Set all bits in mask_img to 1 whose color in ximg is different
7500 from the background color bg. */
7501 for (y
= 0; y
< img
->height
; ++y
)
7502 for (x
= 0; x
< img
->width
; ++x
)
7503 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7505 /* Put mask_img into img->mask. */
7506 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7507 x_destroy_x_image (mask_img
);
7508 XDestroyImage (ximg
);
7516 /***********************************************************************
7517 PBM (mono, gray, color)
7518 ***********************************************************************/
7520 static int pbm_image_p
P_ ((Lisp_Object object
));
7521 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7522 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7524 /* The symbol `pbm' identifying images of this type. */
7528 /* Indices of image specification fields in gs_format, below. */
7530 enum pbm_keyword_index
7544 /* Vector of image_keyword structures describing the format
7545 of valid user-defined image specifications. */
7547 static struct image_keyword pbm_format
[PBM_LAST
] =
7549 {":type", IMAGE_SYMBOL_VALUE
, 1},
7550 {":file", IMAGE_STRING_VALUE
, 0},
7551 {":data", IMAGE_STRING_VALUE
, 0},
7552 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7553 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7554 {":relief", IMAGE_INTEGER_VALUE
, 0},
7555 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7556 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7557 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7560 /* Structure describing the image type `pbm'. */
7562 static struct image_type pbm_type
=
7572 /* Return non-zero if OBJECT is a valid PBM image specification. */
7575 pbm_image_p (object
)
7578 struct image_keyword fmt
[PBM_LAST
];
7580 bcopy (pbm_format
, fmt
, sizeof fmt
);
7582 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
7585 /* Must specify either :data or :file. */
7586 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7590 /* Scan a decimal number from *S and return it. Advance *S while
7591 reading the number. END is the end of the string. Value is -1 at
7595 pbm_scan_number (s
, end
)
7596 unsigned char **s
, *end
;
7598 int c
= 0, val
= -1;
7602 /* Skip white-space. */
7603 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7608 /* Skip comment to end of line. */
7609 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7612 else if (isdigit (c
))
7614 /* Read decimal number. */
7616 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7617 val
= 10 * val
+ c
- '0';
7628 /* Load PBM image IMG for use on frame F. */
7636 int width
, height
, max_color_idx
= 0;
7638 Lisp_Object file
, specified_file
;
7639 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7640 struct gcpro gcpro1
;
7641 unsigned char *contents
= NULL
;
7642 unsigned char *end
, *p
;
7645 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7649 if (STRINGP (specified_file
))
7651 file
= x_find_image_file (specified_file
);
7652 if (!STRINGP (file
))
7654 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7659 contents
= slurp_file (XSTRING (file
)->data
, &size
);
7660 if (contents
== NULL
)
7662 image_error ("Error reading `%s'", file
, Qnil
);
7668 end
= contents
+ size
;
7673 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7674 p
= XSTRING (data
)->data
;
7675 end
= p
+ STRING_BYTES (XSTRING (data
));
7678 /* Check magic number. */
7679 if (end
- p
< 2 || *p
++ != 'P')
7681 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7691 raw_p
= 0, type
= PBM_MONO
;
7695 raw_p
= 0, type
= PBM_GRAY
;
7699 raw_p
= 0, type
= PBM_COLOR
;
7703 raw_p
= 1, type
= PBM_MONO
;
7707 raw_p
= 1, type
= PBM_GRAY
;
7711 raw_p
= 1, type
= PBM_COLOR
;
7715 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7719 /* Read width, height, maximum color-component. Characters
7720 starting with `#' up to the end of a line are ignored. */
7721 width
= pbm_scan_number (&p
, end
);
7722 height
= pbm_scan_number (&p
, end
);
7724 if (type
!= PBM_MONO
)
7726 max_color_idx
= pbm_scan_number (&p
, end
);
7727 if (raw_p
&& max_color_idx
> 255)
7728 max_color_idx
= 255;
7733 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7737 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7738 &ximg
, &img
->pixmap
))
7744 /* Initialize the color hash table. */
7745 init_color_table ();
7747 if (type
== PBM_MONO
)
7751 for (y
= 0; y
< height
; ++y
)
7752 for (x
= 0; x
< width
; ++x
)
7762 g
= pbm_scan_number (&p
, end
);
7764 XPutPixel (ximg
, x
, y
, (g
7765 ? FRAME_FOREGROUND_PIXEL (f
)
7766 : FRAME_BACKGROUND_PIXEL (f
)));
7771 for (y
= 0; y
< height
; ++y
)
7772 for (x
= 0; x
< width
; ++x
)
7776 if (type
== PBM_GRAY
)
7777 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7786 r
= pbm_scan_number (&p
, end
);
7787 g
= pbm_scan_number (&p
, end
);
7788 b
= pbm_scan_number (&p
, end
);
7791 if (r
< 0 || g
< 0 || b
< 0)
7795 XDestroyImage (ximg
);
7797 image_error ("Invalid pixel value in image `%s'",
7802 /* RGB values are now in the range 0..max_color_idx.
7803 Scale this to the range 0..0xffff supported by X. */
7804 r
= (double) r
* 65535 / max_color_idx
;
7805 g
= (double) g
* 65535 / max_color_idx
;
7806 b
= (double) b
* 65535 / max_color_idx
;
7807 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7811 /* Store in IMG->colors the colors allocated for the image, and
7812 free the color table. */
7813 img
->colors
= colors_in_color_table (&img
->ncolors
);
7814 free_color_table ();
7816 /* Put the image into a pixmap. */
7817 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7818 x_destroy_x_image (ximg
);
7822 img
->height
= height
;
7831 /***********************************************************************
7833 ***********************************************************************/
7839 /* Function prototypes. */
7841 static int png_image_p
P_ ((Lisp_Object object
));
7842 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7844 /* The symbol `png' identifying images of this type. */
7848 /* Indices of image specification fields in png_format, below. */
7850 enum png_keyword_index
7864 /* Vector of image_keyword structures describing the format
7865 of valid user-defined image specifications. */
7867 static struct image_keyword png_format
[PNG_LAST
] =
7869 {":type", IMAGE_SYMBOL_VALUE
, 1},
7870 {":data", IMAGE_STRING_VALUE
, 0},
7871 {":file", IMAGE_STRING_VALUE
, 0},
7872 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7873 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7874 {":relief", IMAGE_INTEGER_VALUE
, 0},
7875 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7876 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7877 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7880 /* Structure describing the image type `png'. */
7882 static struct image_type png_type
=
7892 /* Return non-zero if OBJECT is a valid PNG image specification. */
7895 png_image_p (object
)
7898 struct image_keyword fmt
[PNG_LAST
];
7899 bcopy (png_format
, fmt
, sizeof fmt
);
7901 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
7904 /* Must specify either the :data or :file keyword. */
7905 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
7909 /* Error and warning handlers installed when the PNG library
7913 my_png_error (png_ptr
, msg
)
7914 png_struct
*png_ptr
;
7917 xassert (png_ptr
!= NULL
);
7918 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7919 longjmp (png_ptr
->jmpbuf
, 1);
7924 my_png_warning (png_ptr
, msg
)
7925 png_struct
*png_ptr
;
7928 xassert (png_ptr
!= NULL
);
7929 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
7932 /* Memory source for PNG decoding. */
7934 struct png_memory_storage
7936 unsigned char *bytes
; /* The data */
7937 size_t len
; /* How big is it? */
7938 int index
; /* Where are we? */
7942 /* Function set as reader function when reading PNG image from memory.
7943 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
7944 bytes from the input to DATA. */
7947 png_read_from_memory (png_ptr
, data
, length
)
7948 png_structp png_ptr
;
7952 struct png_memory_storage
*tbr
7953 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
7955 if (length
> tbr
->len
- tbr
->index
)
7956 png_error (png_ptr
, "Read error");
7958 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
7959 tbr
->index
= tbr
->index
+ length
;
7962 /* Load PNG image IMG for use on frame F. Value is non-zero if
7970 Lisp_Object file
, specified_file
;
7971 Lisp_Object specified_data
;
7973 XImage
*ximg
, *mask_img
= NULL
;
7974 struct gcpro gcpro1
;
7975 png_struct
*png_ptr
= NULL
;
7976 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
7977 FILE *volatile fp
= NULL
;
7979 png_byte
* volatile pixels
= NULL
;
7980 png_byte
** volatile rows
= NULL
;
7981 png_uint_32 width
, height
;
7982 int bit_depth
, color_type
, interlace_type
;
7984 png_uint_32 row_bytes
;
7987 double screen_gamma
, image_gamma
;
7989 struct png_memory_storage tbr
; /* Data to be read */
7991 /* Find out what file to load. */
7992 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7993 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7997 if (NILP (specified_data
))
7999 file
= x_find_image_file (specified_file
);
8000 if (!STRINGP (file
))
8002 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8007 /* Open the image file. */
8008 fp
= fopen (XSTRING (file
)->data
, "rb");
8011 image_error ("Cannot open image file `%s'", file
, Qnil
);
8017 /* Check PNG signature. */
8018 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8019 || !png_check_sig (sig
, sizeof sig
))
8021 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8029 /* Read from memory. */
8030 tbr
.bytes
= XSTRING (specified_data
)->data
;
8031 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8034 /* Check PNG signature. */
8035 if (tbr
.len
< sizeof sig
8036 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8038 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8043 /* Need to skip past the signature. */
8044 tbr
.bytes
+= sizeof (sig
);
8047 /* Initialize read and info structs for PNG lib. */
8048 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8049 my_png_error
, my_png_warning
);
8052 if (fp
) fclose (fp
);
8057 info_ptr
= png_create_info_struct (png_ptr
);
8060 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8061 if (fp
) fclose (fp
);
8066 end_info
= png_create_info_struct (png_ptr
);
8069 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8070 if (fp
) fclose (fp
);
8075 /* Set error jump-back. We come back here when the PNG library
8076 detects an error. */
8077 if (setjmp (png_ptr
->jmpbuf
))
8081 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8084 if (fp
) fclose (fp
);
8089 /* Read image info. */
8090 if (!NILP (specified_data
))
8091 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8093 png_init_io (png_ptr
, fp
);
8095 png_set_sig_bytes (png_ptr
, sizeof sig
);
8096 png_read_info (png_ptr
, info_ptr
);
8097 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8098 &interlace_type
, NULL
, NULL
);
8100 /* If image contains simply transparency data, we prefer to
8101 construct a clipping mask. */
8102 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8107 /* This function is easier to write if we only have to handle
8108 one data format: RGB or RGBA with 8 bits per channel. Let's
8109 transform other formats into that format. */
8111 /* Strip more than 8 bits per channel. */
8112 if (bit_depth
== 16)
8113 png_set_strip_16 (png_ptr
);
8115 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8117 png_set_expand (png_ptr
);
8119 /* Convert grayscale images to RGB. */
8120 if (color_type
== PNG_COLOR_TYPE_GRAY
8121 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8122 png_set_gray_to_rgb (png_ptr
);
8124 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8125 gamma_str
= getenv ("SCREEN_GAMMA");
8126 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8128 /* Tell the PNG lib to handle gamma correction for us. */
8130 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8131 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8132 /* There is a special chunk in the image specifying the gamma. */
8133 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8136 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8137 /* Image contains gamma information. */
8138 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8140 /* Use a default of 0.5 for the image gamma. */
8141 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8143 /* Handle alpha channel by combining the image with a background
8144 color. Do this only if a real alpha channel is supplied. For
8145 simple transparency, we prefer a clipping mask. */
8148 png_color_16
*image_background
;
8150 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8151 /* Image contains a background color with which to
8152 combine the image. */
8153 png_set_background (png_ptr
, image_background
,
8154 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8157 /* Image does not contain a background color with which
8158 to combine the image data via an alpha channel. Use
8159 the frame's background instead. */
8162 png_color_16 frame_background
;
8165 cmap
= FRAME_X_COLORMAP (f
);
8166 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8167 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8170 bzero (&frame_background
, sizeof frame_background
);
8171 frame_background
.red
= color
.red
;
8172 frame_background
.green
= color
.green
;
8173 frame_background
.blue
= color
.blue
;
8175 png_set_background (png_ptr
, &frame_background
,
8176 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8180 /* Update info structure. */
8181 png_read_update_info (png_ptr
, info_ptr
);
8183 /* Get number of channels. Valid values are 1 for grayscale images
8184 and images with a palette, 2 for grayscale images with transparency
8185 information (alpha channel), 3 for RGB images, and 4 for RGB
8186 images with alpha channel, i.e. RGBA. If conversions above were
8187 sufficient we should only have 3 or 4 channels here. */
8188 channels
= png_get_channels (png_ptr
, info_ptr
);
8189 xassert (channels
== 3 || channels
== 4);
8191 /* Number of bytes needed for one row of the image. */
8192 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8194 /* Allocate memory for the image. */
8195 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8196 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8197 for (i
= 0; i
< height
; ++i
)
8198 rows
[i
] = pixels
+ i
* row_bytes
;
8200 /* Read the entire image. */
8201 png_read_image (png_ptr
, rows
);
8202 png_read_end (png_ptr
, info_ptr
);
8211 /* Create the X image and pixmap. */
8212 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8219 /* Create an image and pixmap serving as mask if the PNG image
8220 contains an alpha channel. */
8223 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8224 &mask_img
, &img
->mask
))
8226 x_destroy_x_image (ximg
);
8227 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8233 /* Fill the X image and mask from PNG data. */
8234 init_color_table ();
8236 for (y
= 0; y
< height
; ++y
)
8238 png_byte
*p
= rows
[y
];
8240 for (x
= 0; x
< width
; ++x
)
8247 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8249 /* An alpha channel, aka mask channel, associates variable
8250 transparency with an image. Where other image formats
8251 support binary transparency---fully transparent or fully
8252 opaque---PNG allows up to 254 levels of partial transparency.
8253 The PNG library implements partial transparency by combining
8254 the image with a specified background color.
8256 I'm not sure how to handle this here nicely: because the
8257 background on which the image is displayed may change, for
8258 real alpha channel support, it would be necessary to create
8259 a new image for each possible background.
8261 What I'm doing now is that a mask is created if we have
8262 boolean transparency information. Otherwise I'm using
8263 the frame's background color to combine the image with. */
8268 XPutPixel (mask_img
, x
, y
, *p
> 0);
8274 /* Remember colors allocated for this image. */
8275 img
->colors
= colors_in_color_table (&img
->ncolors
);
8276 free_color_table ();
8279 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8284 img
->height
= height
;
8286 /* Put the image into the pixmap, then free the X image and its buffer. */
8287 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8288 x_destroy_x_image (ximg
);
8290 /* Same for the mask. */
8293 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8294 x_destroy_x_image (mask_img
);
8302 #endif /* HAVE_PNG != 0 */
8306 /***********************************************************************
8308 ***********************************************************************/
8312 /* Work around a warning about HAVE_STDLIB_H being redefined in
8314 #ifdef HAVE_STDLIB_H
8315 #define HAVE_STDLIB_H_1
8316 #undef HAVE_STDLIB_H
8317 #endif /* HAVE_STLIB_H */
8319 #include <jpeglib.h>
8323 #ifdef HAVE_STLIB_H_1
8324 #define HAVE_STDLIB_H 1
8327 static int jpeg_image_p
P_ ((Lisp_Object object
));
8328 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8330 /* The symbol `jpeg' identifying images of this type. */
8334 /* Indices of image specification fields in gs_format, below. */
8336 enum jpeg_keyword_index
8345 JPEG_HEURISTIC_MASK
,
8350 /* Vector of image_keyword structures describing the format
8351 of valid user-defined image specifications. */
8353 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8355 {":type", IMAGE_SYMBOL_VALUE
, 1},
8356 {":data", IMAGE_STRING_VALUE
, 0},
8357 {":file", IMAGE_STRING_VALUE
, 0},
8358 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8359 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8360 {":relief", IMAGE_INTEGER_VALUE
, 0},
8361 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8362 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8363 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8366 /* Structure describing the image type `jpeg'. */
8368 static struct image_type jpeg_type
=
8378 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8381 jpeg_image_p (object
)
8384 struct image_keyword fmt
[JPEG_LAST
];
8386 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8388 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8391 /* Must specify either the :data or :file keyword. */
8392 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8396 struct my_jpeg_error_mgr
8398 struct jpeg_error_mgr pub
;
8399 jmp_buf setjmp_buffer
;
8404 my_error_exit (cinfo
)
8407 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8408 longjmp (mgr
->setjmp_buffer
, 1);
8412 /* Init source method for JPEG data source manager. Called by
8413 jpeg_read_header() before any data is actually read. See
8414 libjpeg.doc from the JPEG lib distribution. */
8417 our_init_source (cinfo
)
8418 j_decompress_ptr cinfo
;
8423 /* Fill input buffer method for JPEG data source manager. Called
8424 whenever more data is needed. We read the whole image in one step,
8425 so this only adds a fake end of input marker at the end. */
8428 our_fill_input_buffer (cinfo
)
8429 j_decompress_ptr cinfo
;
8431 /* Insert a fake EOI marker. */
8432 struct jpeg_source_mgr
*src
= cinfo
->src
;
8433 static JOCTET buffer
[2];
8435 buffer
[0] = (JOCTET
) 0xFF;
8436 buffer
[1] = (JOCTET
) JPEG_EOI
;
8438 src
->next_input_byte
= buffer
;
8439 src
->bytes_in_buffer
= 2;
8444 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8445 is the JPEG data source manager. */
8448 our_skip_input_data (cinfo
, num_bytes
)
8449 j_decompress_ptr cinfo
;
8452 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8456 if (num_bytes
> src
->bytes_in_buffer
)
8457 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8459 src
->bytes_in_buffer
-= num_bytes
;
8460 src
->next_input_byte
+= num_bytes
;
8465 /* Method to terminate data source. Called by
8466 jpeg_finish_decompress() after all data has been processed. */
8469 our_term_source (cinfo
)
8470 j_decompress_ptr cinfo
;
8475 /* Set up the JPEG lib for reading an image from DATA which contains
8476 LEN bytes. CINFO is the decompression info structure created for
8477 reading the image. */
8480 jpeg_memory_src (cinfo
, data
, len
)
8481 j_decompress_ptr cinfo
;
8485 struct jpeg_source_mgr
*src
;
8487 if (cinfo
->src
== NULL
)
8489 /* First time for this JPEG object? */
8490 cinfo
->src
= (struct jpeg_source_mgr
*)
8491 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8492 sizeof (struct jpeg_source_mgr
));
8493 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8494 src
->next_input_byte
= data
;
8497 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8498 src
->init_source
= our_init_source
;
8499 src
->fill_input_buffer
= our_fill_input_buffer
;
8500 src
->skip_input_data
= our_skip_input_data
;
8501 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8502 src
->term_source
= our_term_source
;
8503 src
->bytes_in_buffer
= len
;
8504 src
->next_input_byte
= data
;
8508 /* Load image IMG for use on frame F. Patterned after example.c
8509 from the JPEG lib. */
8516 struct jpeg_decompress_struct cinfo
;
8517 struct my_jpeg_error_mgr mgr
;
8518 Lisp_Object file
, specified_file
;
8519 Lisp_Object specified_data
;
8520 FILE * volatile fp
= NULL
;
8522 int row_stride
, x
, y
;
8523 XImage
*ximg
= NULL
;
8525 unsigned long *colors
;
8527 struct gcpro gcpro1
;
8529 /* Open the JPEG file. */
8530 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8531 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8535 if (NILP (specified_data
))
8537 file
= x_find_image_file (specified_file
);
8538 if (!STRINGP (file
))
8540 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8545 fp
= fopen (XSTRING (file
)->data
, "r");
8548 image_error ("Cannot open `%s'", file
, Qnil
);
8554 /* Customize libjpeg's error handling to call my_error_exit when an
8555 error is detected. This function will perform a longjmp. */
8556 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8557 mgr
.pub
.error_exit
= my_error_exit
;
8559 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8563 /* Called from my_error_exit. Display a JPEG error. */
8564 char buffer
[JMSG_LENGTH_MAX
];
8565 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8566 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8567 build_string (buffer
));
8570 /* Close the input file and destroy the JPEG object. */
8572 fclose ((FILE *) fp
);
8573 jpeg_destroy_decompress (&cinfo
);
8577 /* If we already have an XImage, free that. */
8578 x_destroy_x_image (ximg
);
8580 /* Free pixmap and colors. */
8581 x_clear_image (f
, img
);
8588 /* Create the JPEG decompression object. Let it read from fp.
8589 Read the JPEG image header. */
8590 jpeg_create_decompress (&cinfo
);
8592 if (NILP (specified_data
))
8593 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
8595 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8596 STRING_BYTES (XSTRING (specified_data
)));
8598 jpeg_read_header (&cinfo
, TRUE
);
8600 /* Customize decompression so that color quantization will be used.
8601 Start decompression. */
8602 cinfo
.quantize_colors
= TRUE
;
8603 jpeg_start_decompress (&cinfo
);
8604 width
= img
->width
= cinfo
.output_width
;
8605 height
= img
->height
= cinfo
.output_height
;
8609 /* Create X image and pixmap. */
8610 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8613 longjmp (mgr
.setjmp_buffer
, 2);
8616 /* Allocate colors. When color quantization is used,
8617 cinfo.actual_number_of_colors has been set with the number of
8618 colors generated, and cinfo.colormap is a two-dimensional array
8619 of color indices in the range 0..cinfo.actual_number_of_colors.
8620 No more than 255 colors will be generated. */
8624 if (cinfo
.out_color_components
> 2)
8625 ir
= 0, ig
= 1, ib
= 2;
8626 else if (cinfo
.out_color_components
> 1)
8627 ir
= 0, ig
= 1, ib
= 0;
8629 ir
= 0, ig
= 0, ib
= 0;
8631 /* Use the color table mechanism because it handles colors that
8632 cannot be allocated nicely. Such colors will be replaced with
8633 a default color, and we don't have to care about which colors
8634 can be freed safely, and which can't. */
8635 init_color_table ();
8636 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8639 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8641 /* Multiply RGB values with 255 because X expects RGB values
8642 in the range 0..0xffff. */
8643 int r
= cinfo
.colormap
[ir
][i
] << 8;
8644 int g
= cinfo
.colormap
[ig
][i
] << 8;
8645 int b
= cinfo
.colormap
[ib
][i
] << 8;
8646 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8649 /* Remember those colors actually allocated. */
8650 img
->colors
= colors_in_color_table (&img
->ncolors
);
8651 free_color_table ();
8655 row_stride
= width
* cinfo
.output_components
;
8656 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8658 for (y
= 0; y
< height
; ++y
)
8660 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8661 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8662 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8666 jpeg_finish_decompress (&cinfo
);
8667 jpeg_destroy_decompress (&cinfo
);
8669 fclose ((FILE *) fp
);
8671 /* Put the image into the pixmap. */
8672 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8673 x_destroy_x_image (ximg
);
8679 #endif /* HAVE_JPEG */
8683 /***********************************************************************
8685 ***********************************************************************/
8691 static int tiff_image_p
P_ ((Lisp_Object object
));
8692 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8694 /* The symbol `tiff' identifying images of this type. */
8698 /* Indices of image specification fields in tiff_format, below. */
8700 enum tiff_keyword_index
8709 TIFF_HEURISTIC_MASK
,
8714 /* Vector of image_keyword structures describing the format
8715 of valid user-defined image specifications. */
8717 static struct image_keyword tiff_format
[TIFF_LAST
] =
8719 {":type", IMAGE_SYMBOL_VALUE
, 1},
8720 {":data", IMAGE_STRING_VALUE
, 0},
8721 {":file", IMAGE_STRING_VALUE
, 0},
8722 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8723 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8724 {":relief", IMAGE_INTEGER_VALUE
, 0},
8725 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8726 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8727 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8730 /* Structure describing the image type `tiff'. */
8732 static struct image_type tiff_type
=
8742 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8745 tiff_image_p (object
)
8748 struct image_keyword fmt
[TIFF_LAST
];
8749 bcopy (tiff_format
, fmt
, sizeof fmt
);
8751 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
8754 /* Must specify either the :data or :file keyword. */
8755 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8759 /* Reading from a memory buffer for TIFF images Based on the PNG
8760 memory source, but we have to provide a lot of extra functions.
8763 We really only need to implement read and seek, but I am not
8764 convinced that the TIFF library is smart enough not to destroy
8765 itself if we only hand it the function pointers we need to
8770 unsigned char *bytes
;
8778 tiff_read_from_memory (data
, buf
, size
)
8783 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8785 if (size
> src
->len
- src
->index
)
8787 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8794 tiff_write_from_memory (data
, buf
, size
)
8804 tiff_seek_in_memory (data
, off
, whence
)
8809 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8814 case SEEK_SET
: /* Go from beginning of source. */
8818 case SEEK_END
: /* Go from end of source. */
8819 idx
= src
->len
+ off
;
8822 case SEEK_CUR
: /* Go from current position. */
8823 idx
= src
->index
+ off
;
8826 default: /* Invalid `whence'. */
8830 if (idx
> src
->len
|| idx
< 0)
8839 tiff_close_memory (data
)
8848 tiff_mmap_memory (data
, pbase
, psize
)
8853 /* It is already _IN_ memory. */
8859 tiff_unmap_memory (data
, base
, size
)
8864 /* We don't need to do this. */
8869 tiff_size_of_memory (data
)
8872 return ((tiff_memory_source
*) data
)->len
;
8876 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8884 Lisp_Object file
, specified_file
;
8885 Lisp_Object specified_data
;
8887 int width
, height
, x
, y
;
8891 struct gcpro gcpro1
;
8892 tiff_memory_source memsrc
;
8894 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8895 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8899 if (NILP (specified_data
))
8901 /* Read from a file */
8902 file
= x_find_image_file (specified_file
);
8903 if (!STRINGP (file
))
8905 image_error ("Cannot find image file `%s'", file
, Qnil
);
8910 /* Try to open the image file. */
8911 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8914 image_error ("Cannot open `%s'", file
, Qnil
);
8921 /* Memory source! */
8922 memsrc
.bytes
= XSTRING (specified_data
)->data
;
8923 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
8926 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
8927 (TIFFReadWriteProc
) tiff_read_from_memory
,
8928 (TIFFReadWriteProc
) tiff_write_from_memory
,
8929 tiff_seek_in_memory
,
8931 tiff_size_of_memory
,
8937 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
8943 /* Get width and height of the image, and allocate a raster buffer
8944 of width x height 32-bit values. */
8945 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8946 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8947 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8949 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8953 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
8961 /* Create the X image and pixmap. */
8962 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8970 /* Initialize the color table. */
8971 init_color_table ();
8973 /* Process the pixel raster. Origin is in the lower-left corner. */
8974 for (y
= 0; y
< height
; ++y
)
8976 uint32
*row
= buf
+ y
* width
;
8978 for (x
= 0; x
< width
; ++x
)
8980 uint32 abgr
= row
[x
];
8981 int r
= TIFFGetR (abgr
) << 8;
8982 int g
= TIFFGetG (abgr
) << 8;
8983 int b
= TIFFGetB (abgr
) << 8;
8984 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8988 /* Remember the colors allocated for the image. Free the color table. */
8989 img
->colors
= colors_in_color_table (&img
->ncolors
);
8990 free_color_table ();
8992 /* Put the image into the pixmap, then free the X image and its buffer. */
8993 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8994 x_destroy_x_image (ximg
);
8999 img
->height
= height
;
9005 #endif /* HAVE_TIFF != 0 */
9009 /***********************************************************************
9011 ***********************************************************************/
9015 #include <gif_lib.h>
9017 static int gif_image_p
P_ ((Lisp_Object object
));
9018 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9020 /* The symbol `gif' identifying images of this type. */
9024 /* Indices of image specification fields in gif_format, below. */
9026 enum gif_keyword_index
9041 /* Vector of image_keyword structures describing the format
9042 of valid user-defined image specifications. */
9044 static struct image_keyword gif_format
[GIF_LAST
] =
9046 {":type", IMAGE_SYMBOL_VALUE
, 1},
9047 {":data", IMAGE_STRING_VALUE
, 0},
9048 {":file", IMAGE_STRING_VALUE
, 0},
9049 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9050 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9051 {":relief", IMAGE_INTEGER_VALUE
, 0},
9052 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9053 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9054 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9055 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9058 /* Structure describing the image type `gif'. */
9060 static struct image_type gif_type
=
9070 /* Return non-zero if OBJECT is a valid GIF image specification. */
9073 gif_image_p (object
)
9076 struct image_keyword fmt
[GIF_LAST
];
9077 bcopy (gif_format
, fmt
, sizeof fmt
);
9079 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9082 /* Must specify either the :data or :file keyword. */
9083 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9087 /* Reading a GIF image from memory
9088 Based on the PNG memory stuff to a certain extent. */
9092 unsigned char *bytes
;
9099 /* Make the current memory source available to gif_read_from_memory.
9100 It's done this way because not all versions of libungif support
9101 a UserData field in the GifFileType structure. */
9102 static gif_memory_source
*current_gif_memory_src
;
9105 gif_read_from_memory (file
, buf
, len
)
9110 gif_memory_source
*src
= current_gif_memory_src
;
9112 if (len
> src
->len
- src
->index
)
9115 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9121 /* Load GIF image IMG for use on frame F. Value is non-zero if
9129 Lisp_Object file
, specified_file
;
9130 Lisp_Object specified_data
;
9131 int rc
, width
, height
, x
, y
, i
;
9133 ColorMapObject
*gif_color_map
;
9134 unsigned long pixel_colors
[256];
9136 struct gcpro gcpro1
;
9138 int ino
, image_left
, image_top
, image_width
, image_height
;
9139 gif_memory_source memsrc
;
9140 unsigned char *raster
;
9142 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9143 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9147 if (NILP (specified_data
))
9149 file
= x_find_image_file (specified_file
);
9150 if (!STRINGP (file
))
9152 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9157 /* Open the GIF file. */
9158 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9161 image_error ("Cannot open `%s'", file
, Qnil
);
9168 /* Read from memory! */
9169 current_gif_memory_src
= &memsrc
;
9170 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9171 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9174 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9177 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9183 /* Read entire contents. */
9184 rc
= DGifSlurp (gif
);
9185 if (rc
== GIF_ERROR
)
9187 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9188 DGifCloseFile (gif
);
9193 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9194 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9195 if (ino
>= gif
->ImageCount
)
9197 image_error ("Invalid image number `%s' in image `%s'",
9199 DGifCloseFile (gif
);
9204 width
= img
->width
= gif
->SWidth
;
9205 height
= img
->height
= gif
->SHeight
;
9209 /* Create the X image and pixmap. */
9210 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9213 DGifCloseFile (gif
);
9218 /* Allocate colors. */
9219 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9221 gif_color_map
= gif
->SColorMap
;
9222 init_color_table ();
9223 bzero (pixel_colors
, sizeof pixel_colors
);
9225 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9227 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9228 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9229 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9230 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9233 img
->colors
= colors_in_color_table (&img
->ncolors
);
9234 free_color_table ();
9236 /* Clear the part of the screen image that are not covered by
9237 the image from the GIF file. Full animated GIF support
9238 requires more than can be done here (see the gif89 spec,
9239 disposal methods). Let's simply assume that the part
9240 not covered by a sub-image is in the frame's background color. */
9241 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9242 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9243 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9244 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9246 for (y
= 0; y
< image_top
; ++y
)
9247 for (x
= 0; x
< width
; ++x
)
9248 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9250 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9251 for (x
= 0; x
< width
; ++x
)
9252 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9254 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9256 for (x
= 0; x
< image_left
; ++x
)
9257 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9258 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9259 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9262 /* Read the GIF image into the X image. We use a local variable
9263 `raster' here because RasterBits below is a char *, and invites
9264 problems with bytes >= 0x80. */
9265 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9267 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9269 static int interlace_start
[] = {0, 4, 2, 1};
9270 static int interlace_increment
[] = {8, 8, 4, 2};
9272 int row
= interlace_start
[0];
9276 for (y
= 0; y
< image_height
; y
++)
9278 if (row
>= image_height
)
9280 row
= interlace_start
[++pass
];
9281 while (row
>= image_height
)
9282 row
= interlace_start
[++pass
];
9285 for (x
= 0; x
< image_width
; x
++)
9287 int i
= raster
[(y
* image_width
) + x
];
9288 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9292 row
+= interlace_increment
[pass
];
9297 for (y
= 0; y
< image_height
; ++y
)
9298 for (x
= 0; x
< image_width
; ++x
)
9300 int i
= raster
[y
* image_width
+ x
];
9301 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9305 DGifCloseFile (gif
);
9307 /* Put the image into the pixmap, then free the X image and its buffer. */
9308 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9309 x_destroy_x_image (ximg
);
9316 #endif /* HAVE_GIF != 0 */
9320 /***********************************************************************
9322 ***********************************************************************/
9324 static int gs_image_p
P_ ((Lisp_Object object
));
9325 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9326 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9328 /* The symbol `postscript' identifying images of this type. */
9330 Lisp_Object Qpostscript
;
9332 /* Keyword symbols. */
9334 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9336 /* Indices of image specification fields in gs_format, below. */
9338 enum gs_keyword_index
9355 /* Vector of image_keyword structures describing the format
9356 of valid user-defined image specifications. */
9358 static struct image_keyword gs_format
[GS_LAST
] =
9360 {":type", IMAGE_SYMBOL_VALUE
, 1},
9361 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9362 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9363 {":file", IMAGE_STRING_VALUE
, 1},
9364 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9365 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9366 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9367 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9368 {":relief", IMAGE_INTEGER_VALUE
, 0},
9369 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9370 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9371 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9374 /* Structure describing the image type `ghostscript'. */
9376 static struct image_type gs_type
=
9386 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9389 gs_clear_image (f
, img
)
9393 /* IMG->data.ptr_val may contain a recorded colormap. */
9394 xfree (img
->data
.ptr_val
);
9395 x_clear_image (f
, img
);
9399 /* Return non-zero if OBJECT is a valid Ghostscript image
9406 struct image_keyword fmt
[GS_LAST
];
9410 bcopy (gs_format
, fmt
, sizeof fmt
);
9412 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9415 /* Bounding box must be a list or vector containing 4 integers. */
9416 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9419 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9420 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9425 else if (VECTORP (tem
))
9427 if (XVECTOR (tem
)->size
!= 4)
9429 for (i
= 0; i
< 4; ++i
)
9430 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9440 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9449 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9450 struct gcpro gcpro1
, gcpro2
;
9452 double in_width
, in_height
;
9453 Lisp_Object pixel_colors
= Qnil
;
9455 /* Compute pixel size of pixmap needed from the given size in the
9456 image specification. Sizes in the specification are in pt. 1 pt
9457 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9459 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9460 in_width
= XFASTINT (pt_width
) / 72.0;
9461 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9462 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9463 in_height
= XFASTINT (pt_height
) / 72.0;
9464 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9466 /* Create the pixmap. */
9468 xassert (img
->pixmap
== 0);
9469 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9470 img
->width
, img
->height
,
9471 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9476 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9480 /* Call the loader to fill the pixmap. It returns a process object
9481 if successful. We do not record_unwind_protect here because
9482 other places in redisplay like calling window scroll functions
9483 don't either. Let the Lisp loader use `unwind-protect' instead. */
9484 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9486 sprintf (buffer
, "%lu %lu",
9487 (unsigned long) FRAME_X_WINDOW (f
),
9488 (unsigned long) img
->pixmap
);
9489 window_and_pixmap_id
= build_string (buffer
);
9491 sprintf (buffer
, "%lu %lu",
9492 FRAME_FOREGROUND_PIXEL (f
),
9493 FRAME_BACKGROUND_PIXEL (f
));
9494 pixel_colors
= build_string (buffer
);
9496 XSETFRAME (frame
, f
);
9497 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9499 loader
= intern ("gs-load-image");
9501 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9502 make_number (img
->width
),
9503 make_number (img
->height
),
9504 window_and_pixmap_id
,
9507 return PROCESSP (img
->data
.lisp_val
);
9511 /* Kill the Ghostscript process that was started to fill PIXMAP on
9512 frame F. Called from XTread_socket when receiving an event
9513 telling Emacs that Ghostscript has finished drawing. */
9516 x_kill_gs_process (pixmap
, f
)
9520 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9524 /* Find the image containing PIXMAP. */
9525 for (i
= 0; i
< c
->used
; ++i
)
9526 if (c
->images
[i
]->pixmap
== pixmap
)
9529 /* Kill the GS process. We should have found PIXMAP in the image
9530 cache and its image should contain a process object. */
9531 xassert (i
< c
->used
);
9533 xassert (PROCESSP (img
->data
.lisp_val
));
9534 Fkill_process (img
->data
.lisp_val
, Qnil
);
9535 img
->data
.lisp_val
= Qnil
;
9537 /* On displays with a mutable colormap, figure out the colors
9538 allocated for the image by looking at the pixels of an XImage for
9540 class = FRAME_X_VISUAL (f
)->class;
9541 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9547 /* Try to get an XImage for img->pixmep. */
9548 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9549 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9554 /* Initialize the color table. */
9555 init_color_table ();
9557 /* For each pixel of the image, look its color up in the
9558 color table. After having done so, the color table will
9559 contain an entry for each color used by the image. */
9560 for (y
= 0; y
< img
->height
; ++y
)
9561 for (x
= 0; x
< img
->width
; ++x
)
9563 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9564 lookup_pixel_color (f
, pixel
);
9567 /* Record colors in the image. Free color table and XImage. */
9568 img
->colors
= colors_in_color_table (&img
->ncolors
);
9569 free_color_table ();
9570 XDestroyImage (ximg
);
9572 #if 0 /* This doesn't seem to be the case. If we free the colors
9573 here, we get a BadAccess later in x_clear_image when
9574 freeing the colors. */
9575 /* We have allocated colors once, but Ghostscript has also
9576 allocated colors on behalf of us. So, to get the
9577 reference counts right, free them once. */
9579 x_free_colors (f
, img
->colors
, img
->ncolors
);
9583 image_error ("Cannot get X image of `%s'; colors will not be freed",
9592 /***********************************************************************
9594 ***********************************************************************/
9596 DEFUN ("x-change-window-property", Fx_change_window_property
,
9597 Sx_change_window_property
, 2, 3, 0,
9598 "Change window property PROP to VALUE on the X window of FRAME.\n\
9599 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9600 selected frame. Value is VALUE.")
9601 (prop
, value
, frame
)
9602 Lisp_Object frame
, prop
, value
;
9604 struct frame
*f
= check_x_frame (frame
);
9607 CHECK_STRING (prop
, 1);
9608 CHECK_STRING (value
, 2);
9611 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9612 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9613 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9614 XSTRING (value
)->data
, XSTRING (value
)->size
);
9616 /* Make sure the property is set when we return. */
9617 XFlush (FRAME_X_DISPLAY (f
));
9624 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9625 Sx_delete_window_property
, 1, 2, 0,
9626 "Remove window property PROP from X window of FRAME.\n\
9627 FRAME nil or omitted means use the selected frame. Value is PROP.")
9629 Lisp_Object prop
, frame
;
9631 struct frame
*f
= check_x_frame (frame
);
9634 CHECK_STRING (prop
, 1);
9636 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9637 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9639 /* Make sure the property is removed when we return. */
9640 XFlush (FRAME_X_DISPLAY (f
));
9647 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9649 "Value is the value of window property PROP on FRAME.\n\
9650 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9651 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9654 Lisp_Object prop
, frame
;
9656 struct frame
*f
= check_x_frame (frame
);
9659 Lisp_Object prop_value
= Qnil
;
9660 char *tmp_data
= NULL
;
9663 unsigned long actual_size
, bytes_remaining
;
9665 CHECK_STRING (prop
, 1);
9667 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9668 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9669 prop_atom
, 0, 0, False
, XA_STRING
,
9670 &actual_type
, &actual_format
, &actual_size
,
9671 &bytes_remaining
, (unsigned char **) &tmp_data
);
9674 int size
= bytes_remaining
;
9679 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9680 prop_atom
, 0, bytes_remaining
,
9682 &actual_type
, &actual_format
,
9683 &actual_size
, &bytes_remaining
,
9684 (unsigned char **) &tmp_data
);
9686 prop_value
= make_string (tmp_data
, size
);
9697 /***********************************************************************
9699 ***********************************************************************/
9701 /* If non-null, an asynchronous timer that, when it expires, displays
9702 a busy cursor on all frames. */
9704 static struct atimer
*busy_cursor_atimer
;
9706 /* Non-zero means a busy cursor is currently shown. */
9708 static int busy_cursor_shown_p
;
9710 /* Number of seconds to wait before displaying a busy cursor. */
9712 static Lisp_Object Vbusy_cursor_delay
;
9714 /* Default number of seconds to wait before displaying a busy
9717 #define DEFAULT_BUSY_CURSOR_DELAY 1
9719 /* Function prototypes. */
9721 static void show_busy_cursor
P_ ((struct atimer
*));
9722 static void hide_busy_cursor
P_ ((void));
9725 /* Cancel a currently active busy-cursor timer, and start a new one. */
9728 start_busy_cursor ()
9731 int secs
, usecs
= 0;
9733 cancel_busy_cursor ();
9735 if (INTEGERP (Vbusy_cursor_delay
)
9736 && XINT (Vbusy_cursor_delay
) > 0)
9737 secs
= XFASTINT (Vbusy_cursor_delay
);
9738 else if (FLOATP (Vbusy_cursor_delay
)
9739 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
9742 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
9743 secs
= XFASTINT (tem
);
9744 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
9747 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
9749 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
9750 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
9751 show_busy_cursor
, NULL
);
9755 /* Cancel the busy cursor timer if active, hide a busy cursor if
9759 cancel_busy_cursor ()
9761 if (busy_cursor_atimer
)
9763 cancel_atimer (busy_cursor_atimer
);
9764 busy_cursor_atimer
= NULL
;
9767 if (busy_cursor_shown_p
)
9768 hide_busy_cursor ();
9772 /* Timer function of busy_cursor_atimer. TIMER is equal to
9775 Display a busy cursor on all frames by mapping the frames'
9776 busy_window. Set the busy_p flag in the frames' output_data.x
9777 structure to indicate that a busy cursor is shown on the
9781 show_busy_cursor (timer
)
9782 struct atimer
*timer
;
9784 /* The timer implementation will cancel this timer automatically
9785 after this function has run. Set busy_cursor_atimer to null
9786 so that we know the timer doesn't have to be canceled. */
9787 busy_cursor_atimer
= NULL
;
9789 if (!busy_cursor_shown_p
)
9791 Lisp_Object rest
, frame
;
9795 FOR_EACH_FRAME (rest
, frame
)
9796 if (FRAME_X_P (XFRAME (frame
)))
9798 struct frame
*f
= XFRAME (frame
);
9800 f
->output_data
.x
->busy_p
= 1;
9802 if (!f
->output_data
.x
->busy_window
)
9804 unsigned long mask
= CWCursor
;
9805 XSetWindowAttributes attrs
;
9807 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9809 f
->output_data
.x
->busy_window
9810 = XCreateWindow (FRAME_X_DISPLAY (f
),
9811 FRAME_OUTER_WINDOW (f
),
9812 0, 0, 32000, 32000, 0, 0,
9818 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9819 XFlush (FRAME_X_DISPLAY (f
));
9822 busy_cursor_shown_p
= 1;
9828 /* Hide the busy cursor on all frames, if it is currently shown. */
9833 if (busy_cursor_shown_p
)
9835 Lisp_Object rest
, frame
;
9838 FOR_EACH_FRAME (rest
, frame
)
9840 struct frame
*f
= XFRAME (frame
);
9843 /* Watch out for newly created frames. */
9844 && f
->output_data
.x
->busy_window
)
9846 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9847 /* Sync here because XTread_socket looks at the busy_p flag
9848 that is reset to zero below. */
9849 XSync (FRAME_X_DISPLAY (f
), False
);
9850 f
->output_data
.x
->busy_p
= 0;
9854 busy_cursor_shown_p
= 0;
9861 /***********************************************************************
9863 ***********************************************************************/
9865 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9868 /* The frame of a currently visible tooltip, or null. */
9870 struct frame
*tip_frame
;
9872 /* If non-nil, a timer started that hides the last tooltip when it
9875 Lisp_Object tip_timer
;
9878 /* Create a frame for a tooltip on the display described by DPYINFO.
9879 PARMS is a list of frame parameters. Value is the frame. */
9882 x_create_tip_frame (dpyinfo
, parms
)
9883 struct x_display_info
*dpyinfo
;
9887 Lisp_Object frame
, tem
;
9889 long window_prompting
= 0;
9891 int count
= specpdl_ptr
- specpdl
;
9892 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9897 /* Use this general default value to start with until we know if
9898 this frame has a specified name. */
9899 Vx_resource_name
= Vinvocation_name
;
9902 kb
= dpyinfo
->kboard
;
9904 kb
= &the_only_kboard
;
9907 /* Get the name of the frame to use for resource lookup. */
9908 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9910 && !EQ (name
, Qunbound
)
9912 error ("Invalid frame name--not a string or nil");
9913 Vx_resource_name
= name
;
9916 GCPRO3 (parms
, name
, frame
);
9917 tip_frame
= f
= make_frame (1);
9918 XSETFRAME (frame
, f
);
9919 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9921 f
->output_method
= output_x_window
;
9922 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9923 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9924 f
->output_data
.x
->icon_bitmap
= -1;
9925 f
->output_data
.x
->fontset
= -1;
9926 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
9927 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
9928 f
->icon_name
= Qnil
;
9929 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9931 FRAME_KBOARD (f
) = kb
;
9933 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9934 f
->output_data
.x
->explicit_parent
= 0;
9936 /* These colors will be set anyway later, but it's important
9937 to get the color reference counts right, so initialize them! */
9940 struct gcpro gcpro1
;
9942 black
= build_string ("black");
9944 f
->output_data
.x
->foreground_pixel
9945 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9946 f
->output_data
.x
->background_pixel
9947 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9948 f
->output_data
.x
->cursor_pixel
9949 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9950 f
->output_data
.x
->cursor_foreground_pixel
9951 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9952 f
->output_data
.x
->border_pixel
9953 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9954 f
->output_data
.x
->mouse_pixel
9955 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
9959 /* Set the name; the functions to which we pass f expect the name to
9961 if (EQ (name
, Qunbound
) || NILP (name
))
9963 f
->name
= build_string (dpyinfo
->x_id_name
);
9964 f
->explicit_name
= 0;
9969 f
->explicit_name
= 1;
9970 /* use the frame's title when getting resources for this frame. */
9971 specbind (Qx_resource_name
, name
);
9974 /* Extract the window parameters from the supplied values
9975 that are needed to determine window geometry. */
9979 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9982 /* First, try whatever font the caller has specified. */
9985 tem
= Fquery_fontset (font
, Qnil
);
9987 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9989 font
= x_new_font (f
, XSTRING (font
)->data
);
9992 /* Try out a font which we hope has bold and italic variations. */
9993 if (!STRINGP (font
))
9994 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9995 if (!STRINGP (font
))
9996 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9997 if (! STRINGP (font
))
9998 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9999 if (! STRINGP (font
))
10000 /* This was formerly the first thing tried, but it finds too many fonts
10001 and takes too long. */
10002 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10003 /* If those didn't work, look for something which will at least work. */
10004 if (! STRINGP (font
))
10005 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10007 if (! STRINGP (font
))
10008 font
= build_string ("fixed");
10010 x_default_parameter (f
, parms
, Qfont
, font
,
10011 "font", "Font", RES_TYPE_STRING
);
10014 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10015 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10017 /* This defaults to 2 in order to match xterm. We recognize either
10018 internalBorderWidth or internalBorder (which is what xterm calls
10020 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10024 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10025 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10026 if (! EQ (value
, Qunbound
))
10027 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10031 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10032 "internalBorderWidth", "internalBorderWidth",
10035 /* Also do the stuff which must be set before the window exists. */
10036 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10037 "foreground", "Foreground", RES_TYPE_STRING
);
10038 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10039 "background", "Background", RES_TYPE_STRING
);
10040 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10041 "pointerColor", "Foreground", RES_TYPE_STRING
);
10042 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10043 "cursorColor", "Foreground", RES_TYPE_STRING
);
10044 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10045 "borderColor", "BorderColor", RES_TYPE_STRING
);
10047 /* Init faces before x_default_parameter is called for scroll-bar
10048 parameters because that function calls x_set_scroll_bar_width,
10049 which calls change_frame_size, which calls Fset_window_buffer,
10050 which runs hooks, which call Fvertical_motion. At the end, we
10051 end up in init_iterator with a null face cache, which should not
10053 init_frame_faces (f
);
10055 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10056 window_prompting
= x_figure_window_size (f
, parms
);
10058 if (window_prompting
& XNegative
)
10060 if (window_prompting
& YNegative
)
10061 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10063 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10067 if (window_prompting
& YNegative
)
10068 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10070 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10073 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10075 XSetWindowAttributes attrs
;
10076 unsigned long mask
;
10079 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10080 /* Window managers look at the override-redirect flag to determine
10081 whether or net to give windows a decoration (Xlib spec, chapter
10083 attrs
.override_redirect
= True
;
10084 attrs
.save_under
= True
;
10085 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10086 /* Arrange for getting MapNotify and UnmapNotify events. */
10087 attrs
.event_mask
= StructureNotifyMask
;
10089 = FRAME_X_WINDOW (f
)
10090 = XCreateWindow (FRAME_X_DISPLAY (f
),
10091 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10092 /* x, y, width, height */
10096 CopyFromParent
, InputOutput
, CopyFromParent
,
10103 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10104 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10105 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10106 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10107 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10108 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10110 /* Dimensions, especially f->height, must be done via change_frame_size.
10111 Change will not be effected unless different from the current
10114 height
= f
->height
;
10116 SET_FRAME_WIDTH (f
, 0);
10117 change_frame_size (f
, height
, width
, 1, 0, 0);
10123 /* It is now ok to make the frame official even if we get an error
10124 below. And the frame needs to be on Vframe_list or making it
10125 visible won't work. */
10126 Vframe_list
= Fcons (frame
, Vframe_list
);
10128 /* Now that the frame is official, it counts as a reference to
10130 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10132 return unbind_to (count
, frame
);
10136 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10137 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10138 A tooltip window is a small X window displaying a string.\n\
10140 FRAME nil or omitted means use the selected frame.\n\
10142 PARMS is an optional list of frame parameters which can be\n\
10143 used to change the tooltip's appearance.\n\
10145 Automatically hide the tooltip after TIMEOUT seconds.\n\
10146 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10148 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10149 the tooltip is displayed at that x-position. Otherwise it is\n\
10150 displayed at the mouse position, with offset DX added (default is 5 if\n\
10151 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10152 parameter is specified, it determines the y-position of the tooltip\n\
10153 window, otherwise it is displayed at the mouse position, with offset\n\
10154 DY added (default is -5).")
10155 (string
, frame
, parms
, timeout
, dx
, dy
)
10156 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10160 Window root
, child
;
10161 Lisp_Object buffer
, top
, left
;
10162 struct buffer
*old_buffer
;
10163 struct text_pos pos
;
10164 int i
, width
, height
;
10165 int root_x
, root_y
, win_x
, win_y
;
10167 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10168 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10169 int count
= specpdl_ptr
- specpdl
;
10171 specbind (Qinhibit_redisplay
, Qt
);
10173 GCPRO4 (string
, parms
, frame
, timeout
);
10175 CHECK_STRING (string
, 0);
10176 f
= check_x_frame (frame
);
10177 if (NILP (timeout
))
10178 timeout
= make_number (5);
10180 CHECK_NATNUM (timeout
, 2);
10183 dx
= make_number (5);
10185 CHECK_NUMBER (dx
, 5);
10188 dy
= make_number (-5);
10190 CHECK_NUMBER (dy
, 6);
10192 /* Hide a previous tip, if any. */
10195 /* Add default values to frame parameters. */
10196 if (NILP (Fassq (Qname
, parms
)))
10197 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10198 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10199 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10200 if (NILP (Fassq (Qborder_width
, parms
)))
10201 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10202 if (NILP (Fassq (Qborder_color
, parms
)))
10203 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10204 if (NILP (Fassq (Qbackground_color
, parms
)))
10205 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10208 /* Create a frame for the tooltip, and record it in the global
10209 variable tip_frame. */
10210 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10211 tip_frame
= f
= XFRAME (frame
);
10213 /* Set up the frame's root window. Currently we use a size of 80
10214 columns x 40 lines. If someone wants to show a larger tip, he
10215 will loose. I don't think this is a realistic case. */
10216 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10217 w
->left
= w
->top
= make_number (0);
10218 w
->width
= make_number (80);
10219 w
->height
= make_number (40);
10221 w
->pseudo_window_p
= 1;
10223 /* Display the tooltip text in a temporary buffer. */
10224 buffer
= Fget_buffer_create (build_string (" *tip*"));
10225 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10226 old_buffer
= current_buffer
;
10227 set_buffer_internal_1 (XBUFFER (buffer
));
10229 Finsert (1, &string
);
10230 clear_glyph_matrix (w
->desired_matrix
);
10231 clear_glyph_matrix (w
->current_matrix
);
10232 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10233 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10235 /* Compute width and height of the tooltip. */
10236 width
= height
= 0;
10237 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10239 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10240 struct glyph
*last
;
10243 /* Stop at the first empty row at the end. */
10244 if (!row
->enabled_p
|| !row
->displays_text_p
)
10247 /* Let the row go over the full width of the frame. */
10248 row
->full_width_p
= 1;
10250 /* There's a glyph at the end of rows that is used to place
10251 the cursor there. Don't include the width of this glyph. */
10252 if (row
->used
[TEXT_AREA
])
10254 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10255 row_width
= row
->pixel_width
- last
->pixel_width
;
10258 row_width
= row
->pixel_width
;
10260 height
+= row
->height
;
10261 width
= max (width
, row_width
);
10264 /* Add the frame's internal border to the width and height the X
10265 window should have. */
10266 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10267 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10269 /* User-specified position? */
10270 left
= Fcdr (Fassq (Qleft
, parms
));
10271 top
= Fcdr (Fassq (Qtop
, parms
));
10273 /* Move the tooltip window where the mouse pointer is. Resize and
10276 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10277 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10280 root_x
+= XINT (dx
);
10281 root_y
+= XINT (dy
);
10283 if (INTEGERP (left
))
10284 root_x
= XINT (left
);
10285 if (INTEGERP (top
))
10286 root_y
= XINT (top
);
10289 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10290 root_x
, root_y
- height
, width
, height
);
10291 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10294 /* Draw into the window. */
10295 w
->must_be_updated_p
= 1;
10296 update_single_window (w
, 1);
10298 /* Restore original current buffer. */
10299 set_buffer_internal_1 (old_buffer
);
10300 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10302 /* Let the tip disappear after timeout seconds. */
10303 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10304 intern ("x-hide-tip"));
10307 return unbind_to (count
, Qnil
);
10311 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10312 "Hide the current tooltip window, if there is any.\n\
10313 Value is t is tooltip was open, nil otherwise.")
10316 int count
= specpdl_ptr
- specpdl
;
10319 specbind (Qinhibit_redisplay
, Qt
);
10321 if (!NILP (tip_timer
))
10323 call1 (intern ("cancel-timer"), tip_timer
);
10331 XSETFRAME (frame
, tip_frame
);
10332 Fdelete_frame (frame
, Qt
);
10337 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10342 /***********************************************************************
10343 File selection dialog
10344 ***********************************************************************/
10348 /* Callback for "OK" and "Cancel" on file selection dialog. */
10351 file_dialog_cb (widget
, client_data
, call_data
)
10353 XtPointer call_data
, client_data
;
10355 int *result
= (int *) client_data
;
10356 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10357 *result
= cb
->reason
;
10361 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10362 "Read file name, prompting with PROMPT in directory DIR.\n\
10363 Use a file selection dialog.\n\
10364 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10365 specified. Don't let the user enter a file name in the file\n\
10366 selection dialog's entry field, if MUSTMATCH is non-nil.")
10367 (prompt
, dir
, default_filename
, mustmatch
)
10368 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10371 struct frame
*f
= SELECTED_FRAME ();
10372 Lisp_Object file
= Qnil
;
10373 Widget dialog
, text
, list
, help
;
10376 extern XtAppContext Xt_app_con
;
10378 XmString dir_xmstring
, pattern_xmstring
;
10379 int popup_activated_flag
;
10380 int count
= specpdl_ptr
- specpdl
;
10381 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10383 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10384 CHECK_STRING (prompt
, 0);
10385 CHECK_STRING (dir
, 1);
10387 /* Prevent redisplay. */
10388 specbind (Qinhibit_redisplay
, Qt
);
10392 /* Create the dialog with PROMPT as title, using DIR as initial
10393 directory and using "*" as pattern. */
10394 dir
= Fexpand_file_name (dir
, Qnil
);
10395 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10396 pattern_xmstring
= XmStringCreateLocalized ("*");
10398 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10399 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10400 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10401 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10402 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10403 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10405 XmStringFree (dir_xmstring
);
10406 XmStringFree (pattern_xmstring
);
10408 /* Add callbacks for OK and Cancel. */
10409 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10410 (XtPointer
) &result
);
10411 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10412 (XtPointer
) &result
);
10414 /* Disable the help button since we can't display help. */
10415 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10416 XtSetSensitive (help
, False
);
10418 /* Mark OK button as default. */
10419 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10420 XmNshowAsDefault
, True
, NULL
);
10422 /* If MUSTMATCH is non-nil, disable the file entry field of the
10423 dialog, so that the user must select a file from the files list
10424 box. We can't remove it because we wouldn't have a way to get at
10425 the result file name, then. */
10426 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10427 if (!NILP (mustmatch
))
10430 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10431 XtSetSensitive (text
, False
);
10432 XtSetSensitive (label
, False
);
10435 /* Manage the dialog, so that list boxes get filled. */
10436 XtManageChild (dialog
);
10438 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10439 must include the path for this to work. */
10440 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10441 if (STRINGP (default_filename
))
10443 XmString default_xmstring
;
10447 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10449 if (!XmListItemExists (list
, default_xmstring
))
10451 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10452 XmListAddItem (list
, default_xmstring
, 0);
10456 item_pos
= XmListItemPos (list
, default_xmstring
);
10457 XmStringFree (default_xmstring
);
10459 /* Select the item and scroll it into view. */
10460 XmListSelectPos (list
, item_pos
, True
);
10461 XmListSetPos (list
, item_pos
);
10464 #ifdef HAVE_MOTIF_2_1
10466 /* Process events until the user presses Cancel or OK. */
10468 while (result
== 0 || XtAppPending (Xt_app_con
))
10469 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10471 #else /* not HAVE_MOTIF_2_1 */
10473 /* Process all events until the user presses Cancel or OK. */
10474 for (result
= 0; result
== 0;)
10477 Widget widget
, parent
;
10479 XtAppNextEvent (Xt_app_con
, &event
);
10481 /* See if the receiver of the event is one of the widgets of
10482 the file selection dialog. If so, dispatch it. If not,
10484 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10486 while (parent
&& parent
!= dialog
)
10487 parent
= XtParent (parent
);
10489 if (parent
== dialog
10490 || (event
.type
== Expose
10491 && !process_expose_from_menu (event
)))
10492 XtDispatchEvent (&event
);
10495 #endif /* not HAVE_MOTIF_2_1 */
10497 /* Get the result. */
10498 if (result
== XmCR_OK
)
10503 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
10504 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10505 XmStringFree (text
);
10506 file
= build_string (data
);
10513 XtUnmanageChild (dialog
);
10514 XtDestroyWidget (dialog
);
10518 /* Make "Cancel" equivalent to C-g. */
10520 Fsignal (Qquit
, Qnil
);
10522 return unbind_to (count
, file
);
10525 #endif /* USE_MOTIF */
10529 /***********************************************************************
10531 ***********************************************************************/
10536 /* This is zero if not using X windows. */
10539 /* The section below is built by the lisp expression at the top of the file,
10540 just above where these variables are declared. */
10541 /*&&& init symbols here &&&*/
10542 Qauto_raise
= intern ("auto-raise");
10543 staticpro (&Qauto_raise
);
10544 Qauto_lower
= intern ("auto-lower");
10545 staticpro (&Qauto_lower
);
10546 Qbar
= intern ("bar");
10548 Qborder_color
= intern ("border-color");
10549 staticpro (&Qborder_color
);
10550 Qborder_width
= intern ("border-width");
10551 staticpro (&Qborder_width
);
10552 Qbox
= intern ("box");
10554 Qcursor_color
= intern ("cursor-color");
10555 staticpro (&Qcursor_color
);
10556 Qcursor_type
= intern ("cursor-type");
10557 staticpro (&Qcursor_type
);
10558 Qgeometry
= intern ("geometry");
10559 staticpro (&Qgeometry
);
10560 Qicon_left
= intern ("icon-left");
10561 staticpro (&Qicon_left
);
10562 Qicon_top
= intern ("icon-top");
10563 staticpro (&Qicon_top
);
10564 Qicon_type
= intern ("icon-type");
10565 staticpro (&Qicon_type
);
10566 Qicon_name
= intern ("icon-name");
10567 staticpro (&Qicon_name
);
10568 Qinternal_border_width
= intern ("internal-border-width");
10569 staticpro (&Qinternal_border_width
);
10570 Qleft
= intern ("left");
10571 staticpro (&Qleft
);
10572 Qright
= intern ("right");
10573 staticpro (&Qright
);
10574 Qmouse_color
= intern ("mouse-color");
10575 staticpro (&Qmouse_color
);
10576 Qnone
= intern ("none");
10577 staticpro (&Qnone
);
10578 Qparent_id
= intern ("parent-id");
10579 staticpro (&Qparent_id
);
10580 Qscroll_bar_width
= intern ("scroll-bar-width");
10581 staticpro (&Qscroll_bar_width
);
10582 Qsuppress_icon
= intern ("suppress-icon");
10583 staticpro (&Qsuppress_icon
);
10584 Qundefined_color
= intern ("undefined-color");
10585 staticpro (&Qundefined_color
);
10586 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10587 staticpro (&Qvertical_scroll_bars
);
10588 Qvisibility
= intern ("visibility");
10589 staticpro (&Qvisibility
);
10590 Qwindow_id
= intern ("window-id");
10591 staticpro (&Qwindow_id
);
10592 Qouter_window_id
= intern ("outer-window-id");
10593 staticpro (&Qouter_window_id
);
10594 Qx_frame_parameter
= intern ("x-frame-parameter");
10595 staticpro (&Qx_frame_parameter
);
10596 Qx_resource_name
= intern ("x-resource-name");
10597 staticpro (&Qx_resource_name
);
10598 Quser_position
= intern ("user-position");
10599 staticpro (&Quser_position
);
10600 Quser_size
= intern ("user-size");
10601 staticpro (&Quser_size
);
10602 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10603 staticpro (&Qscroll_bar_foreground
);
10604 Qscroll_bar_background
= intern ("scroll-bar-background");
10605 staticpro (&Qscroll_bar_background
);
10606 Qscreen_gamma
= intern ("screen-gamma");
10607 staticpro (&Qscreen_gamma
);
10608 Qline_spacing
= intern ("line-spacing");
10609 staticpro (&Qline_spacing
);
10610 Qcenter
= intern ("center");
10611 staticpro (&Qcenter
);
10612 Qcompound_text
= intern ("compound-text");
10613 staticpro (&Qcompound_text
);
10614 /* This is the end of symbol initialization. */
10616 /* Text property `display' should be nonsticky by default. */
10617 Vtext_property_default_nonsticky
10618 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10621 Qlaplace
= intern ("laplace");
10622 staticpro (&Qlaplace
);
10623 Qemboss
= intern ("emboss");
10624 staticpro (&Qemboss
);
10625 Qedge_detection
= intern ("edge-detection");
10626 staticpro (&Qedge_detection
);
10627 Qheuristic
= intern ("heuristic");
10628 staticpro (&Qheuristic
);
10629 QCmatrix
= intern (":matrix");
10630 staticpro (&QCmatrix
);
10631 QCcolor_adjustment
= intern (":color-adjustment");
10632 staticpro (&QCcolor_adjustment
);
10633 QCmask
= intern (":mask");
10634 staticpro (&QCmask
);
10636 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10637 staticpro (&Qface_set_after_frame_default
);
10639 Fput (Qundefined_color
, Qerror_conditions
,
10640 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10641 Fput (Qundefined_color
, Qerror_message
,
10642 build_string ("Undefined color"));
10644 init_x_parm_symbols ();
10646 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10647 "List of directories to search for bitmap files for X.");
10648 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10650 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10651 "The shape of the pointer when over text.\n\
10652 Changing the value does not affect existing frames\n\
10653 unless you set the mouse color.");
10654 Vx_pointer_shape
= Qnil
;
10656 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10657 "The name Emacs uses to look up X resources.\n\
10658 `x-get-resource' uses this as the first component of the instance name\n\
10659 when requesting resource values.\n\
10660 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10661 was invoked, or to the value specified with the `-name' or `-rn'\n\
10662 switches, if present.\n\
10664 It may be useful to bind this variable locally around a call\n\
10665 to `x-get-resource'. See also the variable `x-resource-class'.");
10666 Vx_resource_name
= Qnil
;
10668 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10669 "The class Emacs uses to look up X resources.\n\
10670 `x-get-resource' uses this as the first component of the instance class\n\
10671 when requesting resource values.\n\
10672 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10674 Setting this variable permanently is not a reasonable thing to do,\n\
10675 but binding this variable locally around a call to `x-get-resource'\n\
10676 is a reasonable practice. See also the variable `x-resource-name'.");
10677 Vx_resource_class
= build_string (EMACS_CLASS
);
10679 #if 0 /* This doesn't really do anything. */
10680 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10681 "The shape of the pointer when not over text.\n\
10682 This variable takes effect when you create a new frame\n\
10683 or when you set the mouse color.");
10685 Vx_nontext_pointer_shape
= Qnil
;
10687 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10688 "The shape of the pointer when Emacs is busy.\n\
10689 This variable takes effect when you create a new frame\n\
10690 or when you set the mouse color.");
10691 Vx_busy_pointer_shape
= Qnil
;
10693 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10694 "Non-zero means Emacs displays a busy cursor on window systems.");
10695 display_busy_cursor_p
= 1;
10697 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
10698 "*Seconds to wait before displaying a busy-cursor.\n\
10699 Value must be an integer or float.");
10700 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
10702 #if 0 /* This doesn't really do anything. */
10703 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10704 "The shape of the pointer when over the mode line.\n\
10705 This variable takes effect when you create a new frame\n\
10706 or when you set the mouse color.");
10708 Vx_mode_pointer_shape
= Qnil
;
10710 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10711 &Vx_sensitive_text_pointer_shape
,
10712 "The shape of the pointer when over mouse-sensitive text.\n\
10713 This variable takes effect when you create a new frame\n\
10714 or when you set the mouse color.");
10715 Vx_sensitive_text_pointer_shape
= Qnil
;
10717 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10718 "A string indicating the foreground color of the cursor box.");
10719 Vx_cursor_fore_pixel
= Qnil
;
10721 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10722 "Non-nil if no X window manager is in use.\n\
10723 Emacs doesn't try to figure this out; this is always nil\n\
10724 unless you set it to something else.");
10725 /* We don't have any way to find this out, so set it to nil
10726 and maybe the user would like to set it to t. */
10727 Vx_no_window_manager
= Qnil
;
10729 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10730 &Vx_pixel_size_width_font_regexp
,
10731 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10733 Since Emacs gets width of a font matching with this regexp from\n\
10734 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10735 such a font. This is especially effective for such large fonts as\n\
10736 Chinese, Japanese, and Korean.");
10737 Vx_pixel_size_width_font_regexp
= Qnil
;
10739 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10740 "Time after which cached images are removed from the cache.\n\
10741 When an image has not been displayed this many seconds, remove it\n\
10742 from the image cache. Value must be an integer or nil with nil\n\
10743 meaning don't clear the cache.");
10744 Vimage_cache_eviction_delay
= make_number (30 * 60);
10746 #ifdef USE_X_TOOLKIT
10747 Fprovide (intern ("x-toolkit"));
10750 Fprovide (intern ("motif"));
10753 defsubr (&Sx_get_resource
);
10755 /* X window properties. */
10756 defsubr (&Sx_change_window_property
);
10757 defsubr (&Sx_delete_window_property
);
10758 defsubr (&Sx_window_property
);
10760 defsubr (&Sxw_display_color_p
);
10761 defsubr (&Sx_display_grayscale_p
);
10762 defsubr (&Sxw_color_defined_p
);
10763 defsubr (&Sxw_color_values
);
10764 defsubr (&Sx_server_max_request_size
);
10765 defsubr (&Sx_server_vendor
);
10766 defsubr (&Sx_server_version
);
10767 defsubr (&Sx_display_pixel_width
);
10768 defsubr (&Sx_display_pixel_height
);
10769 defsubr (&Sx_display_mm_width
);
10770 defsubr (&Sx_display_mm_height
);
10771 defsubr (&Sx_display_screens
);
10772 defsubr (&Sx_display_planes
);
10773 defsubr (&Sx_display_color_cells
);
10774 defsubr (&Sx_display_visual_class
);
10775 defsubr (&Sx_display_backing_store
);
10776 defsubr (&Sx_display_save_under
);
10777 defsubr (&Sx_parse_geometry
);
10778 defsubr (&Sx_create_frame
);
10779 defsubr (&Sx_open_connection
);
10780 defsubr (&Sx_close_connection
);
10781 defsubr (&Sx_display_list
);
10782 defsubr (&Sx_synchronize
);
10783 defsubr (&Sx_focus_frame
);
10785 /* Setting callback functions for fontset handler. */
10786 get_font_info_func
= x_get_font_info
;
10788 #if 0 /* This function pointer doesn't seem to be used anywhere.
10789 And the pointer assigned has the wrong type, anyway. */
10790 list_fonts_func
= x_list_fonts
;
10793 load_font_func
= x_load_font
;
10794 find_ccl_program_func
= x_find_ccl_program
;
10795 query_font_func
= x_query_font
;
10796 set_frame_fontset_func
= x_set_font
;
10797 check_window_system_func
= check_x
;
10800 Qxbm
= intern ("xbm");
10802 QCtype
= intern (":type");
10803 staticpro (&QCtype
);
10804 QCalgorithm
= intern (":algorithm");
10805 staticpro (&QCalgorithm
);
10806 QCheuristic_mask
= intern (":heuristic-mask");
10807 staticpro (&QCheuristic_mask
);
10808 QCcolor_symbols
= intern (":color-symbols");
10809 staticpro (&QCcolor_symbols
);
10810 QCascent
= intern (":ascent");
10811 staticpro (&QCascent
);
10812 QCmargin
= intern (":margin");
10813 staticpro (&QCmargin
);
10814 QCrelief
= intern (":relief");
10815 staticpro (&QCrelief
);
10816 Qpostscript
= intern ("postscript");
10817 staticpro (&Qpostscript
);
10818 QCloader
= intern (":loader");
10819 staticpro (&QCloader
);
10820 QCbounding_box
= intern (":bounding-box");
10821 staticpro (&QCbounding_box
);
10822 QCpt_width
= intern (":pt-width");
10823 staticpro (&QCpt_width
);
10824 QCpt_height
= intern (":pt-height");
10825 staticpro (&QCpt_height
);
10826 QCindex
= intern (":index");
10827 staticpro (&QCindex
);
10828 Qpbm
= intern ("pbm");
10832 Qxpm
= intern ("xpm");
10837 Qjpeg
= intern ("jpeg");
10838 staticpro (&Qjpeg
);
10842 Qtiff
= intern ("tiff");
10843 staticpro (&Qtiff
);
10847 Qgif
= intern ("gif");
10852 Qpng
= intern ("png");
10856 defsubr (&Sclear_image_cache
);
10857 defsubr (&Simage_size
);
10859 busy_cursor_atimer
= NULL
;
10860 busy_cursor_shown_p
= 0;
10862 defsubr (&Sx_show_tip
);
10863 defsubr (&Sx_hide_tip
);
10864 staticpro (&tip_timer
);
10868 defsubr (&Sx_file_dialog
);
10876 image_types
= NULL
;
10877 Vimage_types
= Qnil
;
10879 define_image_type (&xbm_type
);
10880 define_image_type (&gs_type
);
10881 define_image_type (&pbm_type
);
10884 define_image_type (&xpm_type
);
10888 define_image_type (&jpeg_type
);
10892 define_image_type (&tiff_type
);
10896 define_image_type (&gif_type
);
10900 define_image_type (&png_type
);
10904 #endif /* HAVE_X_WINDOWS */