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 /* If non-nil, the pointer shape to indicate that windows can be
153 dragged horizontally. */
155 Lisp_Object Vx_window_horizontal_drag_shape
;
157 /* Color of chars displayed in cursor box. */
159 Lisp_Object Vx_cursor_fore_pixel
;
161 /* Nonzero if using X. */
165 /* Non nil if no window manager is in use. */
167 Lisp_Object Vx_no_window_manager
;
169 /* Search path for bitmap files. */
171 Lisp_Object Vx_bitmap_file_path
;
173 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
175 Lisp_Object Vx_pixel_size_width_font_regexp
;
177 /* Evaluate this expression to rebuild the section of syms_of_xfns
178 that initializes and staticpros the symbols declared below. Note
179 that Emacs 18 has a bug that keeps C-x C-e from being able to
180 evaluate this expression.
183 ;; Accumulate a list of the symbols we want to initialize from the
184 ;; declarations at the top of the file.
185 (goto-char (point-min))
186 (search-forward "/\*&&& symbols declared here &&&*\/\n")
188 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
190 (cons (buffer-substring (match-beginning 1) (match-end 1))
193 (setq symbol-list (nreverse symbol-list))
194 ;; Delete the section of syms_of_... where we initialize the symbols.
195 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
196 (let ((start (point)))
197 (while (looking-at "^ Q")
199 (kill-region start (point)))
200 ;; Write a new symbol initialization section.
202 (insert (format " %s = intern (\"" (car symbol-list)))
203 (let ((start (point)))
204 (insert (substring (car symbol-list) 1))
205 (subst-char-in-region start (point) ?_ ?-))
206 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
207 (setq symbol-list (cdr symbol-list)))))
211 /*&&& symbols declared here &&&*/
212 Lisp_Object Qauto_raise
;
213 Lisp_Object Qauto_lower
;
215 Lisp_Object Qborder_color
;
216 Lisp_Object Qborder_width
;
218 Lisp_Object Qcursor_color
;
219 Lisp_Object Qcursor_type
;
220 Lisp_Object Qgeometry
;
221 Lisp_Object Qicon_left
;
222 Lisp_Object Qicon_top
;
223 Lisp_Object Qicon_type
;
224 Lisp_Object Qicon_name
;
225 Lisp_Object Qinternal_border_width
;
228 Lisp_Object Qmouse_color
;
230 Lisp_Object Qouter_window_id
;
231 Lisp_Object Qparent_id
;
232 Lisp_Object Qscroll_bar_width
;
233 Lisp_Object Qsuppress_icon
;
234 extern Lisp_Object Qtop
;
235 Lisp_Object Qundefined_color
;
236 Lisp_Object Qvertical_scroll_bars
;
237 Lisp_Object Qvisibility
;
238 Lisp_Object Qwindow_id
;
239 Lisp_Object Qx_frame_parameter
;
240 Lisp_Object Qx_resource_name
;
241 Lisp_Object Quser_position
;
242 Lisp_Object Quser_size
;
243 extern Lisp_Object Qdisplay
;
244 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
245 Lisp_Object Qscreen_gamma
, Qline_spacing
, Qcenter
;
246 Lisp_Object Qcompound_text
;
248 /* The below are defined in frame.c. */
250 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
251 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
252 extern Lisp_Object Qtool_bar_lines
;
254 extern Lisp_Object Vwindow_system_version
;
256 Lisp_Object Qface_set_after_frame_default
;
259 /* Error if we are not connected to X. */
265 error ("X windows are not in use or not initialized");
268 /* Nonzero if we can use mouse menus.
269 You should not call this unless HAVE_MENUS is defined. */
277 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
278 and checking validity for X. */
281 check_x_frame (frame
)
287 frame
= selected_frame
;
288 CHECK_LIVE_FRAME (frame
, 0);
291 error ("Non-X frame used");
295 /* Let the user specify an X display with a frame.
296 nil stands for the selected frame--or, if that is not an X frame,
297 the first X display on the list. */
299 static struct x_display_info
*
300 check_x_display_info (frame
)
303 struct x_display_info
*dpyinfo
= NULL
;
307 struct frame
*sf
= XFRAME (selected_frame
);
309 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
310 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
311 else if (x_display_list
!= 0)
312 dpyinfo
= x_display_list
;
314 error ("X windows are not in use or not initialized");
316 else if (STRINGP (frame
))
317 dpyinfo
= x_display_info_for_name (frame
);
322 CHECK_LIVE_FRAME (frame
, 0);
325 error ("Non-X frame used");
326 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
333 /* Return the Emacs frame-object corresponding to an X window.
334 It could be the frame's main window or an icon window. */
336 /* This function can be called during GC, so use GC_xxx type test macros. */
339 x_window_to_frame (dpyinfo
, wdesc
)
340 struct x_display_info
*dpyinfo
;
343 Lisp_Object tail
, frame
;
346 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
349 if (!GC_FRAMEP (frame
))
352 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
354 if (f
->output_data
.x
->busy_window
== wdesc
)
357 if ((f
->output_data
.x
->edit_widget
358 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
359 /* A tooltip frame? */
360 || (!f
->output_data
.x
->edit_widget
361 && FRAME_X_WINDOW (f
) == wdesc
)
362 || f
->output_data
.x
->icon_desc
== wdesc
)
364 #else /* not USE_X_TOOLKIT */
365 if (FRAME_X_WINDOW (f
) == wdesc
366 || f
->output_data
.x
->icon_desc
== wdesc
)
368 #endif /* not USE_X_TOOLKIT */
374 /* Like x_window_to_frame but also compares the window with the widget's
378 x_any_window_to_frame (dpyinfo
, wdesc
)
379 struct x_display_info
*dpyinfo
;
382 Lisp_Object tail
, frame
;
383 struct frame
*f
, *found
;
387 for (tail
= Vframe_list
; GC_CONSP (tail
) && !found
; tail
= XCDR (tail
))
390 if (!GC_FRAMEP (frame
))
394 if (FRAME_X_P (f
) && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
)
396 /* This frame matches if the window is any of its widgets. */
397 x
= f
->output_data
.x
;
398 if (x
->busy_window
== wdesc
)
402 if (wdesc
== XtWindow (x
->widget
)
403 || wdesc
== XtWindow (x
->column_widget
)
404 || wdesc
== XtWindow (x
->edit_widget
))
406 /* Match if the window is this frame's menubar. */
407 else if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
410 else if (FRAME_X_WINDOW (f
) == wdesc
)
411 /* A tooltip frame. */
419 /* Likewise, but exclude the menu bar widget. */
422 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
423 struct x_display_info
*dpyinfo
;
426 Lisp_Object tail
, frame
;
430 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
433 if (!GC_FRAMEP (frame
))
436 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
438 x
= f
->output_data
.x
;
439 /* This frame matches if the window is any of its widgets. */
440 if (x
->busy_window
== wdesc
)
444 if (wdesc
== XtWindow (x
->widget
)
445 || wdesc
== XtWindow (x
->column_widget
)
446 || wdesc
== XtWindow (x
->edit_widget
))
449 else if (FRAME_X_WINDOW (f
) == wdesc
)
450 /* A tooltip frame. */
456 /* Likewise, but consider only the menu bar widget. */
459 x_menubar_window_to_frame (dpyinfo
, wdesc
)
460 struct x_display_info
*dpyinfo
;
463 Lisp_Object tail
, frame
;
467 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
470 if (!GC_FRAMEP (frame
))
473 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
475 x
= f
->output_data
.x
;
476 /* Match if the window is this frame's menubar. */
477 if (x
->menubar_widget
478 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
484 /* Return the frame whose principal (outermost) window is WDESC.
485 If WDESC is some other (smaller) window, we return 0. */
488 x_top_window_to_frame (dpyinfo
, wdesc
)
489 struct x_display_info
*dpyinfo
;
492 Lisp_Object tail
, frame
;
496 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
499 if (!GC_FRAMEP (frame
))
502 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
504 x
= f
->output_data
.x
;
508 /* This frame matches if the window is its topmost widget. */
509 if (wdesc
== XtWindow (x
->widget
))
511 #if 0 /* I don't know why it did this,
512 but it seems logically wrong,
513 and it causes trouble for MapNotify events. */
514 /* Match if the window is this frame's menubar. */
515 if (x
->menubar_widget
516 && wdesc
== XtWindow (x
->menubar_widget
))
520 else if (FRAME_X_WINDOW (f
) == wdesc
)
526 #endif /* USE_X_TOOLKIT */
530 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
531 id, which is just an int that this section returns. Bitmaps are
532 reference counted so they can be shared among frames.
534 Bitmap indices are guaranteed to be > 0, so a negative number can
535 be used to indicate no bitmap.
537 If you use x_create_bitmap_from_data, then you must keep track of
538 the bitmaps yourself. That is, creating a bitmap from the same
539 data more than once will not be caught. */
542 /* Functions to access the contents of a bitmap, given an id. */
545 x_bitmap_height (f
, id
)
549 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
553 x_bitmap_width (f
, id
)
557 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
561 x_bitmap_pixmap (f
, id
)
565 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
569 /* Allocate a new bitmap record. Returns index of new record. */
572 x_allocate_bitmap_record (f
)
575 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
578 if (dpyinfo
->bitmaps
== NULL
)
580 dpyinfo
->bitmaps_size
= 10;
582 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
583 dpyinfo
->bitmaps_last
= 1;
587 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
588 return ++dpyinfo
->bitmaps_last
;
590 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
591 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
594 dpyinfo
->bitmaps_size
*= 2;
596 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
597 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
598 return ++dpyinfo
->bitmaps_last
;
601 /* Add one reference to the reference count of the bitmap with id ID. */
604 x_reference_bitmap (f
, id
)
608 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
611 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
614 x_create_bitmap_from_data (f
, bits
, width
, height
)
617 unsigned int width
, height
;
619 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
623 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
624 bits
, width
, height
);
629 id
= x_allocate_bitmap_record (f
);
630 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
631 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
632 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
633 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
634 dpyinfo
->bitmaps
[id
- 1].height
= height
;
635 dpyinfo
->bitmaps
[id
- 1].width
= width
;
640 /* Create bitmap from file FILE for frame F. */
643 x_create_bitmap_from_file (f
, file
)
647 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
648 unsigned int width
, height
;
650 int xhot
, yhot
, result
, id
;
655 /* Look for an existing bitmap with the same name. */
656 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
658 if (dpyinfo
->bitmaps
[id
].refcount
659 && dpyinfo
->bitmaps
[id
].file
660 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
662 ++dpyinfo
->bitmaps
[id
].refcount
;
667 /* Search bitmap-file-path for the file, if appropriate. */
668 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
673 filename
= (char *) XSTRING (found
)->data
;
675 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
676 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
677 if (result
!= BitmapSuccess
)
680 id
= x_allocate_bitmap_record (f
);
681 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
682 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
683 dpyinfo
->bitmaps
[id
- 1].file
684 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
685 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
686 dpyinfo
->bitmaps
[id
- 1].height
= height
;
687 dpyinfo
->bitmaps
[id
- 1].width
= width
;
688 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
693 /* Remove reference to bitmap with id number ID. */
696 x_destroy_bitmap (f
, id
)
700 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
704 --dpyinfo
->bitmaps
[id
- 1].refcount
;
705 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
708 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
709 if (dpyinfo
->bitmaps
[id
- 1].file
)
711 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
712 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
719 /* Free all the bitmaps for the display specified by DPYINFO. */
722 x_destroy_all_bitmaps (dpyinfo
)
723 struct x_display_info
*dpyinfo
;
726 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
727 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
729 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
730 if (dpyinfo
->bitmaps
[i
].file
)
731 xfree (dpyinfo
->bitmaps
[i
].file
);
733 dpyinfo
->bitmaps_last
= 0;
736 /* Connect the frame-parameter names for X frames
737 to the ways of passing the parameter values to the window system.
739 The name of a parameter, as a Lisp symbol,
740 has an `x-frame-parameter' property which is an integer in Lisp
741 that is an index in this table. */
743 struct x_frame_parm_table
746 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 static void x_change_window_heights
P_ ((Lisp_Object
, int));
750 static void x_disable_image
P_ ((struct frame
*, struct image
*));
751 static void x_create_im
P_ ((struct frame
*));
752 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 static void x_set_line_spacing
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
765 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
770 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
774 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
775 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
776 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
778 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
780 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
785 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
786 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
788 static void init_color_table
P_ ((void));
789 static void free_color_table
P_ ((void));
790 static unsigned long *colors_in_color_table
P_ ((int *n
));
791 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
792 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
796 static struct x_frame_parm_table x_frame_parms
[] =
798 "auto-raise", x_set_autoraise
,
799 "auto-lower", x_set_autolower
,
800 "background-color", x_set_background_color
,
801 "border-color", x_set_border_color
,
802 "border-width", x_set_border_width
,
803 "cursor-color", x_set_cursor_color
,
804 "cursor-type", x_set_cursor_type
,
806 "foreground-color", x_set_foreground_color
,
807 "icon-name", x_set_icon_name
,
808 "icon-type", x_set_icon_type
,
809 "internal-border-width", x_set_internal_border_width
,
810 "menu-bar-lines", x_set_menu_bar_lines
,
811 "mouse-color", x_set_mouse_color
,
812 "name", x_explicitly_set_name
,
813 "scroll-bar-width", x_set_scroll_bar_width
,
814 "title", x_set_title
,
815 "unsplittable", x_set_unsplittable
,
816 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
817 "visibility", x_set_visibility
,
818 "tool-bar-lines", x_set_tool_bar_lines
,
819 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
820 "scroll-bar-background", x_set_scroll_bar_background
,
821 "screen-gamma", x_set_screen_gamma
,
822 "line-spacing", x_set_line_spacing
825 /* Attach the `x-frame-parameter' properties to
826 the Lisp symbol names of parameters relevant to X. */
829 init_x_parm_symbols ()
833 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
834 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
838 /* Change the parameters of frame F as specified by ALIST.
839 If a parameter is not specially recognized, do nothing special;
840 otherwise call the `x_set_...' function for that parameter.
841 Except for certain geometry properties, always call store_frame_param
842 to store the new value in the parameter alist. */
845 x_set_frame_parameters (f
, alist
)
851 /* If both of these parameters are present, it's more efficient to
852 set them both at once. So we wait until we've looked at the
853 entire list before we set them. */
857 Lisp_Object left
, top
;
859 /* Same with these. */
860 Lisp_Object icon_left
, icon_top
;
862 /* Record in these vectors all the parms specified. */
866 int left_no_change
= 0, top_no_change
= 0;
867 int icon_left_no_change
= 0, icon_top_no_change
= 0;
869 struct gcpro gcpro1
, gcpro2
;
872 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
875 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
876 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
878 /* Extract parm names and values into those vectors. */
881 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
886 parms
[i
] = Fcar (elt
);
887 values
[i
] = Fcdr (elt
);
890 /* TAIL and ALIST are not used again below here. */
893 GCPRO2 (*parms
, *values
);
897 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
898 because their values appear in VALUES and strings are not valid. */
899 top
= left
= Qunbound
;
900 icon_left
= icon_top
= Qunbound
;
902 /* Provide default values for HEIGHT and WIDTH. */
903 if (FRAME_NEW_WIDTH (f
))
904 width
= FRAME_NEW_WIDTH (f
);
906 width
= FRAME_WIDTH (f
);
908 if (FRAME_NEW_HEIGHT (f
))
909 height
= FRAME_NEW_HEIGHT (f
);
911 height
= FRAME_HEIGHT (f
);
913 /* Process foreground_color and background_color before anything else.
914 They are independent of other properties, but other properties (e.g.,
915 cursor_color) are dependent upon them. */
916 for (p
= 0; p
< i
; p
++)
918 Lisp_Object prop
, val
;
922 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
924 register Lisp_Object param_index
, old_value
;
926 param_index
= Fget (prop
, Qx_frame_parameter
);
927 old_value
= get_frame_param (f
, prop
);
928 store_frame_param (f
, prop
, val
);
929 if (NATNUMP (param_index
)
930 && (XFASTINT (param_index
)
931 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
932 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
936 /* Now process them in reverse of specified order. */
937 for (i
--; i
>= 0; i
--)
939 Lisp_Object prop
, val
;
944 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
945 width
= XFASTINT (val
);
946 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
947 height
= XFASTINT (val
);
948 else if (EQ (prop
, Qtop
))
950 else if (EQ (prop
, Qleft
))
952 else if (EQ (prop
, Qicon_top
))
954 else if (EQ (prop
, Qicon_left
))
956 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
957 /* Processed above. */
961 register Lisp_Object param_index
, old_value
;
963 param_index
= Fget (prop
, Qx_frame_parameter
);
964 old_value
= get_frame_param (f
, prop
);
965 store_frame_param (f
, prop
, val
);
966 if (NATNUMP (param_index
)
967 && (XFASTINT (param_index
)
968 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
969 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
973 /* Don't die if just one of these was set. */
974 if (EQ (left
, Qunbound
))
977 if (f
->output_data
.x
->left_pos
< 0)
978 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
980 XSETINT (left
, f
->output_data
.x
->left_pos
);
982 if (EQ (top
, Qunbound
))
985 if (f
->output_data
.x
->top_pos
< 0)
986 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
988 XSETINT (top
, f
->output_data
.x
->top_pos
);
991 /* If one of the icon positions was not set, preserve or default it. */
992 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
994 icon_left_no_change
= 1;
995 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
996 if (NILP (icon_left
))
997 XSETINT (icon_left
, 0);
999 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
1001 icon_top_no_change
= 1;
1002 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
1003 if (NILP (icon_top
))
1004 XSETINT (icon_top
, 0);
1007 /* Don't set these parameters unless they've been explicitly
1008 specified. The window might be mapped or resized while we're in
1009 this function, and we don't want to override that unless the lisp
1010 code has asked for it.
1012 Don't set these parameters unless they actually differ from the
1013 window's current parameters; the window may not actually exist
1018 check_frame_size (f
, &height
, &width
);
1020 XSETFRAME (frame
, f
);
1022 if (width
!= FRAME_WIDTH (f
)
1023 || height
!= FRAME_HEIGHT (f
)
1024 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1025 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1027 if ((!NILP (left
) || !NILP (top
))
1028 && ! (left_no_change
&& top_no_change
)
1029 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1030 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1035 /* Record the signs. */
1036 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1037 if (EQ (left
, Qminus
))
1038 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1039 else if (INTEGERP (left
))
1041 leftpos
= XINT (left
);
1043 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1045 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1046 && CONSP (XCDR (left
))
1047 && INTEGERP (XCAR (XCDR (left
))))
1049 leftpos
= - XINT (XCAR (XCDR (left
)));
1050 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1052 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1053 && CONSP (XCDR (left
))
1054 && INTEGERP (XCAR (XCDR (left
))))
1056 leftpos
= XINT (XCAR (XCDR (left
)));
1059 if (EQ (top
, Qminus
))
1060 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1061 else if (INTEGERP (top
))
1063 toppos
= XINT (top
);
1065 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1067 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1068 && CONSP (XCDR (top
))
1069 && INTEGERP (XCAR (XCDR (top
))))
1071 toppos
= - XINT (XCAR (XCDR (top
)));
1072 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1074 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1075 && CONSP (XCDR (top
))
1076 && INTEGERP (XCAR (XCDR (top
))))
1078 toppos
= XINT (XCAR (XCDR (top
)));
1082 /* Store the numeric value of the position. */
1083 f
->output_data
.x
->top_pos
= toppos
;
1084 f
->output_data
.x
->left_pos
= leftpos
;
1086 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1088 /* Actually set that position, and convert to absolute. */
1089 x_set_offset (f
, leftpos
, toppos
, -1);
1092 if ((!NILP (icon_left
) || !NILP (icon_top
))
1093 && ! (icon_left_no_change
&& icon_top_no_change
))
1094 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1100 /* Store the screen positions of frame F into XPTR and YPTR.
1101 These are the positions of the containing window manager window,
1102 not Emacs's own window. */
1105 x_real_positions (f
, xptr
, yptr
)
1112 /* This is pretty gross, but seems to be the easiest way out of
1113 the problem that arises when restarting window-managers. */
1115 #ifdef USE_X_TOOLKIT
1116 Window outer
= (f
->output_data
.x
->widget
1117 ? XtWindow (f
->output_data
.x
->widget
)
1118 : FRAME_X_WINDOW (f
));
1120 Window outer
= f
->output_data
.x
->window_desc
;
1122 Window tmp_root_window
;
1123 Window
*tmp_children
;
1124 unsigned int tmp_nchildren
;
1128 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1129 Window outer_window
;
1131 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1132 &f
->output_data
.x
->parent_desc
,
1133 &tmp_children
, &tmp_nchildren
);
1134 XFree ((char *) tmp_children
);
1138 /* Find the position of the outside upper-left corner of
1139 the inner window, with respect to the outer window. */
1140 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1141 outer_window
= f
->output_data
.x
->parent_desc
;
1143 outer_window
= outer
;
1145 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1147 /* From-window, to-window. */
1149 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1151 /* From-position, to-position. */
1152 0, 0, &win_x
, &win_y
,
1157 /* It is possible for the window returned by the XQueryNotify
1158 to become invalid by the time we call XTranslateCoordinates.
1159 That can happen when you restart some window managers.
1160 If so, we get an error in XTranslateCoordinates.
1161 Detect that and try the whole thing over. */
1162 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1164 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1168 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1175 /* Insert a description of internally-recorded parameters of frame X
1176 into the parameter alist *ALISTPTR that is to be given to the user.
1177 Only parameters that are specific to the X window system
1178 and whose values are not correctly recorded in the frame's
1179 param_alist need to be considered here. */
1182 x_report_frame_params (f
, alistptr
)
1184 Lisp_Object
*alistptr
;
1189 /* Represent negative positions (off the top or left screen edge)
1190 in a way that Fmodify_frame_parameters will understand correctly. */
1191 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1192 if (f
->output_data
.x
->left_pos
>= 0)
1193 store_in_alist (alistptr
, Qleft
, tem
);
1195 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1197 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1198 if (f
->output_data
.x
->top_pos
>= 0)
1199 store_in_alist (alistptr
, Qtop
, tem
);
1201 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1203 store_in_alist (alistptr
, Qborder_width
,
1204 make_number (f
->output_data
.x
->border_width
));
1205 store_in_alist (alistptr
, Qinternal_border_width
,
1206 make_number (f
->output_data
.x
->internal_border_width
));
1207 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1208 store_in_alist (alistptr
, Qwindow_id
,
1209 build_string (buf
));
1210 #ifdef USE_X_TOOLKIT
1211 /* Tooltip frame may not have this widget. */
1212 if (f
->output_data
.x
->widget
)
1214 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1215 store_in_alist (alistptr
, Qouter_window_id
,
1216 build_string (buf
));
1217 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1218 FRAME_SAMPLE_VISIBILITY (f
);
1219 store_in_alist (alistptr
, Qvisibility
,
1220 (FRAME_VISIBLE_P (f
) ? Qt
1221 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1222 store_in_alist (alistptr
, Qdisplay
,
1223 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1225 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1228 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1229 store_in_alist (alistptr
, Qparent_id
, tem
);
1234 /* Gamma-correct COLOR on frame F. */
1237 gamma_correct (f
, color
)
1243 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1244 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1245 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1250 /* Decide if color named COLOR_NAME is valid for use on frame F. If
1251 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1252 allocate the color. Value is zero if COLOR_NAME is invalid, or
1253 no color could be allocated. */
1256 x_defined_color (f
, color_name
, color
, alloc_p
)
1263 Display
*dpy
= FRAME_X_DISPLAY (f
);
1264 Colormap cmap
= FRAME_X_COLORMAP (f
);
1267 success_p
= XParseColor (dpy
, cmap
, color_name
, color
);
1268 if (success_p
&& alloc_p
)
1269 success_p
= x_alloc_nearest_color (f
, cmap
, color
);
1276 /* Return the pixel color value for color COLOR_NAME on frame F. If F
1277 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1278 Signal an error if color can't be allocated. */
1281 x_decode_color (f
, color_name
, mono_color
)
1283 Lisp_Object color_name
;
1288 CHECK_STRING (color_name
, 0);
1290 #if 0 /* Don't do this. It's wrong when we're not using the default
1291 colormap, it makes freeing difficult, and it's probably not
1292 an important optimization. */
1293 if (strcmp (XSTRING (color_name
)->data
, "black") == 0)
1294 return BLACK_PIX_DEFAULT (f
);
1295 else if (strcmp (XSTRING (color_name
)->data
, "white") == 0)
1296 return WHITE_PIX_DEFAULT (f
);
1299 /* Return MONO_COLOR for monochrome frames. */
1300 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1303 /* x_defined_color is responsible for coping with failures
1304 by looking for a near-miss. */
1305 if (x_defined_color (f
, XSTRING (color_name
)->data
, &cdef
, 1))
1308 Fsignal (Qerror
, Fcons (build_string ("Undefined color"),
1309 Fcons (color_name
, Qnil
)));
1315 /* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1316 the previous value of that parameter, NEW_VALUE is the new value. */
1319 x_set_line_spacing (f
, new_value
, old_value
)
1321 Lisp_Object new_value
, old_value
;
1323 if (NILP (new_value
))
1324 f
->extra_line_spacing
= 0;
1325 else if (NATNUMP (new_value
))
1326 f
->extra_line_spacing
= XFASTINT (new_value
);
1328 Fsignal (Qerror
, Fcons (build_string ("Invalid line-spacing"),
1329 Fcons (new_value
, Qnil
)));
1330 if (FRAME_VISIBLE_P (f
))
1335 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1336 the previous value of that parameter, NEW_VALUE is the new value. */
1339 x_set_screen_gamma (f
, new_value
, old_value
)
1341 Lisp_Object new_value
, old_value
;
1343 if (NILP (new_value
))
1345 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1346 /* The value 0.4545 is the normal viewing gamma. */
1347 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1349 Fsignal (Qerror
, Fcons (build_string ("Invalid screen-gamma"),
1350 Fcons (new_value
, Qnil
)));
1352 clear_face_cache (0);
1356 /* Functions called only from `x_set_frame_param'
1357 to set individual parameters.
1359 If FRAME_X_WINDOW (f) is 0,
1360 the frame is being created and its X-window does not exist yet.
1361 In that case, just record the parameter's new value
1362 in the standard place; do not attempt to change the window. */
1365 x_set_foreground_color (f
, arg
, oldval
)
1367 Lisp_Object arg
, oldval
;
1370 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1372 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1373 f
->output_data
.x
->foreground_pixel
= pixel
;
1375 if (FRAME_X_WINDOW (f
) != 0)
1378 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1379 f
->output_data
.x
->foreground_pixel
);
1380 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1381 f
->output_data
.x
->foreground_pixel
);
1383 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1384 if (FRAME_VISIBLE_P (f
))
1390 x_set_background_color (f
, arg
, oldval
)
1392 Lisp_Object arg
, oldval
;
1395 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1397 unload_color (f
, f
->output_data
.x
->background_pixel
);
1398 f
->output_data
.x
->background_pixel
= pixel
;
1400 if (FRAME_X_WINDOW (f
) != 0)
1403 /* The main frame area. */
1404 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1405 f
->output_data
.x
->background_pixel
);
1406 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1407 f
->output_data
.x
->background_pixel
);
1408 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1409 f
->output_data
.x
->background_pixel
);
1410 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1411 f
->output_data
.x
->background_pixel
);
1414 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1415 bar
= XSCROLL_BAR (bar
)->next
)
1416 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1417 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1418 f
->output_data
.x
->background_pixel
);
1422 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1424 if (FRAME_VISIBLE_P (f
))
1430 x_set_mouse_color (f
, arg
, oldval
)
1432 Lisp_Object arg
, oldval
;
1434 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1435 Cursor busy_cursor
, horizontal_drag_cursor
;
1437 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1438 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1440 /* Don't let pointers be invisible. */
1441 if (mask_color
== pixel
1442 && mask_color
== f
->output_data
.x
->background_pixel
)
1443 pixel
= f
->output_data
.x
->foreground_pixel
;
1445 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1446 f
->output_data
.x
->mouse_pixel
= pixel
;
1450 /* It's not okay to crash if the user selects a screwy cursor. */
1451 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1453 if (!EQ (Qnil
, Vx_pointer_shape
))
1455 CHECK_NUMBER (Vx_pointer_shape
, 0);
1456 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1459 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1460 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1462 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1464 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1465 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1466 XINT (Vx_nontext_pointer_shape
));
1469 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1470 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1472 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1474 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1475 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1476 XINT (Vx_busy_pointer_shape
));
1479 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1480 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1482 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1483 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1485 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1486 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1487 XINT (Vx_mode_pointer_shape
));
1490 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1491 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1493 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1495 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1497 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1498 XINT (Vx_sensitive_text_pointer_shape
));
1501 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1503 if (!NILP (Vx_window_horizontal_drag_shape
))
1505 CHECK_NUMBER (Vx_window_horizontal_drag_shape
, 0);
1506 horizontal_drag_cursor
1507 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1508 XINT (Vx_window_horizontal_drag_shape
));
1511 horizontal_drag_cursor
1512 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1514 /* Check and report errors with the above calls. */
1515 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1516 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1519 XColor fore_color
, back_color
;
1521 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1522 x_query_color (f
, &fore_color
);
1523 back_color
.pixel
= mask_color
;
1524 x_query_color (f
, &back_color
);
1526 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1527 &fore_color
, &back_color
);
1528 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1529 &fore_color
, &back_color
);
1530 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1531 &fore_color
, &back_color
);
1532 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1533 &fore_color
, &back_color
);
1534 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1535 &fore_color
, &back_color
);
1536 XRecolorCursor (FRAME_X_DISPLAY (f
), horizontal_drag_cursor
,
1537 &fore_color
, &back_color
);
1540 if (FRAME_X_WINDOW (f
) != 0)
1541 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1543 if (cursor
!= f
->output_data
.x
->text_cursor
1544 && f
->output_data
.x
->text_cursor
!= 0)
1545 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1546 f
->output_data
.x
->text_cursor
= cursor
;
1548 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1549 && f
->output_data
.x
->nontext_cursor
!= 0)
1550 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1551 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1553 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1554 && f
->output_data
.x
->busy_cursor
!= 0)
1555 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1556 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1558 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1559 && f
->output_data
.x
->modeline_cursor
!= 0)
1560 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1561 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1563 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1564 && f
->output_data
.x
->cross_cursor
!= 0)
1565 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1566 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1568 if (horizontal_drag_cursor
!= f
->output_data
.x
->horizontal_drag_cursor
1569 && f
->output_data
.x
->horizontal_drag_cursor
!= 0)
1570 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->horizontal_drag_cursor
);
1571 f
->output_data
.x
->horizontal_drag_cursor
= horizontal_drag_cursor
;
1573 XFlush (FRAME_X_DISPLAY (f
));
1576 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1580 x_set_cursor_color (f
, arg
, oldval
)
1582 Lisp_Object arg
, oldval
;
1584 unsigned long fore_pixel
, pixel
;
1585 int fore_pixel_allocated_p
= 0, pixel_allocated_p
= 0;
1587 if (!NILP (Vx_cursor_fore_pixel
))
1589 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1590 WHITE_PIX_DEFAULT (f
));
1591 fore_pixel_allocated_p
= 1;
1594 fore_pixel
= f
->output_data
.x
->background_pixel
;
1596 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1597 pixel_allocated_p
= 1;
1599 /* Make sure that the cursor color differs from the background color. */
1600 if (pixel
== f
->output_data
.x
->background_pixel
)
1602 if (pixel_allocated_p
)
1604 x_free_colors (f
, &pixel
, 1);
1605 pixel_allocated_p
= 0;
1608 pixel
= f
->output_data
.x
->mouse_pixel
;
1609 if (pixel
== fore_pixel
)
1611 if (fore_pixel_allocated_p
)
1613 x_free_colors (f
, &fore_pixel
, 1);
1614 fore_pixel_allocated_p
= 0;
1616 fore_pixel
= f
->output_data
.x
->background_pixel
;
1620 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1621 if (!fore_pixel_allocated_p
)
1622 fore_pixel
= x_copy_color (f
, fore_pixel
);
1623 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1625 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1626 if (!pixel_allocated_p
)
1627 pixel
= x_copy_color (f
, pixel
);
1628 f
->output_data
.x
->cursor_pixel
= pixel
;
1630 if (FRAME_X_WINDOW (f
) != 0)
1633 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1634 f
->output_data
.x
->cursor_pixel
);
1635 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1639 if (FRAME_VISIBLE_P (f
))
1641 x_update_cursor (f
, 0);
1642 x_update_cursor (f
, 1);
1646 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1649 /* Set the border-color of frame F to value described by ARG.
1650 ARG can be a string naming a color.
1651 The border-color is used for the border that is drawn by the X server.
1652 Note that this does not fully take effect if done before
1653 F has an x-window; it must be redone when the window is created.
1655 Note: this is done in two routines because of the way X10 works.
1657 Note: under X11, this is normally the province of the window manager,
1658 and so emacs' border colors may be overridden. */
1661 x_set_border_color (f
, arg
, oldval
)
1663 Lisp_Object arg
, oldval
;
1667 CHECK_STRING (arg
, 0);
1668 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1669 x_set_border_pixel (f
, pix
);
1670 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1673 /* Set the border-color of frame F to pixel value PIX.
1674 Note that this does not fully take effect if done before
1675 F has an x-window. */
1678 x_set_border_pixel (f
, pix
)
1682 unload_color (f
, f
->output_data
.x
->border_pixel
);
1683 f
->output_data
.x
->border_pixel
= pix
;
1685 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1688 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1689 (unsigned long)pix
);
1692 if (FRAME_VISIBLE_P (f
))
1698 /* Value is the internal representation of the specified cursor type
1699 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1700 of the bar cursor. */
1702 enum text_cursor_kinds
1703 x_specified_cursor_type (arg
, width
)
1707 enum text_cursor_kinds type
;
1714 else if (CONSP (arg
)
1715 && EQ (XCAR (arg
), Qbar
)
1716 && INTEGERP (XCDR (arg
))
1717 && XINT (XCDR (arg
)) >= 0)
1720 *width
= XINT (XCDR (arg
));
1722 else if (NILP (arg
))
1725 /* Treat anything unknown as "box cursor".
1726 It was bad to signal an error; people have trouble fixing
1727 .Xdefaults with Emacs, when it has something bad in it. */
1728 type
= FILLED_BOX_CURSOR
;
1734 x_set_cursor_type (f
, arg
, oldval
)
1736 Lisp_Object arg
, oldval
;
1740 FRAME_DESIRED_CURSOR (f
) = x_specified_cursor_type (arg
, &width
);
1741 f
->output_data
.x
->cursor_width
= width
;
1743 /* Make sure the cursor gets redrawn. This is overkill, but how
1744 often do people change cursor types? */
1745 update_mode_lines
++;
1749 x_set_icon_type (f
, arg
, oldval
)
1751 Lisp_Object arg
, oldval
;
1757 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1760 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1765 result
= x_text_icon (f
,
1766 (char *) XSTRING ((!NILP (f
->icon_name
)
1770 result
= x_bitmap_icon (f
, arg
);
1775 error ("No icon window available");
1778 XFlush (FRAME_X_DISPLAY (f
));
1782 /* Return non-nil if frame F wants a bitmap icon. */
1790 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1798 x_set_icon_name (f
, arg
, oldval
)
1800 Lisp_Object arg
, oldval
;
1806 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1809 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1814 if (f
->output_data
.x
->icon_bitmap
!= 0)
1819 result
= x_text_icon (f
,
1820 (char *) XSTRING ((!NILP (f
->icon_name
)
1829 error ("No icon window available");
1832 XFlush (FRAME_X_DISPLAY (f
));
1837 x_set_font (f
, arg
, oldval
)
1839 Lisp_Object arg
, oldval
;
1842 Lisp_Object fontset_name
;
1845 CHECK_STRING (arg
, 1);
1847 fontset_name
= Fquery_fontset (arg
, Qnil
);
1850 result
= (STRINGP (fontset_name
)
1851 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1852 : x_new_font (f
, XSTRING (arg
)->data
));
1855 if (EQ (result
, Qnil
))
1856 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1857 else if (EQ (result
, Qt
))
1858 error ("The characters of the given font have varying widths");
1859 else if (STRINGP (result
))
1861 store_frame_param (f
, Qfont
, result
);
1862 recompute_basic_faces (f
);
1867 do_pending_window_change (0);
1869 /* Don't call `face-set-after-frame-default' when faces haven't been
1870 initialized yet. This is the case when called from
1871 Fx_create_frame. In that case, the X widget or window doesn't
1872 exist either, and we can end up in x_report_frame_params with a
1873 null widget which gives a segfault. */
1874 if (FRAME_FACE_CACHE (f
))
1876 XSETFRAME (frame
, f
);
1877 call1 (Qface_set_after_frame_default
, frame
);
1882 x_set_border_width (f
, arg
, oldval
)
1884 Lisp_Object arg
, oldval
;
1886 CHECK_NUMBER (arg
, 0);
1888 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1891 if (FRAME_X_WINDOW (f
) != 0)
1892 error ("Cannot change the border width of a window");
1894 f
->output_data
.x
->border_width
= XINT (arg
);
1898 x_set_internal_border_width (f
, arg
, oldval
)
1900 Lisp_Object arg
, oldval
;
1902 int old
= f
->output_data
.x
->internal_border_width
;
1904 CHECK_NUMBER (arg
, 0);
1905 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1906 if (f
->output_data
.x
->internal_border_width
< 0)
1907 f
->output_data
.x
->internal_border_width
= 0;
1909 #ifdef USE_X_TOOLKIT
1910 if (f
->output_data
.x
->edit_widget
)
1911 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1914 if (f
->output_data
.x
->internal_border_width
== old
)
1917 if (FRAME_X_WINDOW (f
) != 0)
1919 x_set_window_size (f
, 0, f
->width
, f
->height
);
1920 SET_FRAME_GARBAGED (f
);
1921 do_pending_window_change (0);
1926 x_set_visibility (f
, value
, oldval
)
1928 Lisp_Object value
, oldval
;
1931 XSETFRAME (frame
, f
);
1934 Fmake_frame_invisible (frame
, Qt
);
1935 else if (EQ (value
, Qicon
))
1936 Ficonify_frame (frame
);
1938 Fmake_frame_visible (frame
);
1942 /* Change window heights in windows rooted in WINDOW by N lines. */
1945 x_change_window_heights (window
, n
)
1949 struct window
*w
= XWINDOW (window
);
1951 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1952 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1954 if (INTEGERP (w
->orig_top
))
1955 XSETFASTINT (w
->orig_top
, XFASTINT (w
->orig_top
) + n
);
1956 if (INTEGERP (w
->orig_height
))
1957 XSETFASTINT (w
->orig_height
, XFASTINT (w
->orig_height
) - n
);
1959 /* Handle just the top child in a vertical split. */
1960 if (!NILP (w
->vchild
))
1961 x_change_window_heights (w
->vchild
, n
);
1963 /* Adjust all children in a horizontal split. */
1964 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1966 w
= XWINDOW (window
);
1967 x_change_window_heights (window
, n
);
1972 x_set_menu_bar_lines (f
, value
, oldval
)
1974 Lisp_Object value
, oldval
;
1977 #ifndef USE_X_TOOLKIT
1978 int olines
= FRAME_MENU_BAR_LINES (f
);
1981 /* Right now, menu bars don't work properly in minibuf-only frames;
1982 most of the commands try to apply themselves to the minibuffer
1983 frame itself, and get an error because you can't switch buffers
1984 in or split the minibuffer window. */
1985 if (FRAME_MINIBUF_ONLY_P (f
))
1988 if (INTEGERP (value
))
1989 nlines
= XINT (value
);
1993 /* Make sure we redisplay all windows in this frame. */
1994 windows_or_buffers_changed
++;
1996 #ifdef USE_X_TOOLKIT
1997 FRAME_MENU_BAR_LINES (f
) = 0;
2000 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2001 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
2002 /* Make sure next redisplay shows the menu bar. */
2003 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
2007 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2008 free_frame_menubar (f
);
2009 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2011 f
->output_data
.x
->menubar_widget
= 0;
2013 #else /* not USE_X_TOOLKIT */
2014 FRAME_MENU_BAR_LINES (f
) = nlines
;
2015 x_change_window_heights (f
->root_window
, nlines
- olines
);
2016 #endif /* not USE_X_TOOLKIT */
2021 /* Set the number of lines used for the tool bar of frame F to VALUE.
2022 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2023 is the old number of tool bar lines. This function changes the
2024 height of all windows on frame F to match the new tool bar height.
2025 The frame's height doesn't change. */
2028 x_set_tool_bar_lines (f
, value
, oldval
)
2030 Lisp_Object value
, oldval
;
2032 int delta
, nlines
, root_height
;
2033 Lisp_Object root_window
;
2035 /* Use VALUE only if an integer >= 0. */
2036 if (INTEGERP (value
) && XINT (value
) >= 0)
2037 nlines
= XFASTINT (value
);
2041 /* Make sure we redisplay all windows in this frame. */
2042 ++windows_or_buffers_changed
;
2044 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2046 /* Don't resize the tool-bar to more than we have room for. */
2047 root_window
= FRAME_ROOT_WINDOW (f
);
2048 root_height
= XINT (XWINDOW (root_window
)->height
);
2049 if (root_height
- delta
< 1)
2051 delta
= root_height
- 1;
2052 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
2055 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2056 x_change_window_heights (root_window
, delta
);
2059 /* We also have to make sure that the internal border at the top of
2060 the frame, below the menu bar or tool bar, is redrawn when the
2061 tool bar disappears. This is so because the internal border is
2062 below the tool bar if one is displayed, but is below the menu bar
2063 if there isn't a tool bar. The tool bar draws into the area
2064 below the menu bar. */
2065 if (FRAME_X_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
2069 clear_current_matrices (f
);
2070 updating_frame
= NULL
;
2073 /* If the tool bar gets smaller, the internal border below it
2074 has to be cleared. It was formerly part of the display
2075 of the larger tool bar, and updating windows won't clear it. */
2078 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
2079 int width
= PIXEL_WIDTH (f
);
2080 int y
= nlines
* CANON_Y_UNIT (f
);
2083 XClearArea (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2084 0, y
, width
, height
, False
);
2090 /* Set the foreground color for scroll bars on frame F to VALUE.
2091 VALUE should be a string, a color name. If it isn't a string or
2092 isn't a valid color name, do nothing. OLDVAL is the old value of
2093 the frame parameter. */
2096 x_set_scroll_bar_foreground (f
, value
, oldval
)
2098 Lisp_Object value
, oldval
;
2100 unsigned long pixel
;
2102 if (STRINGP (value
))
2103 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2107 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2108 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2110 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2111 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2113 /* Remove all scroll bars because they have wrong colors. */
2114 if (condemn_scroll_bars_hook
)
2115 (*condemn_scroll_bars_hook
) (f
);
2116 if (judge_scroll_bars_hook
)
2117 (*judge_scroll_bars_hook
) (f
);
2119 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2125 /* Set the background color for scroll bars on frame F to VALUE VALUE
2126 should be a string, a color name. If it isn't a string or isn't a
2127 valid color name, do nothing. OLDVAL is the old value of the frame
2131 x_set_scroll_bar_background (f
, value
, oldval
)
2133 Lisp_Object value
, oldval
;
2135 unsigned long pixel
;
2137 if (STRINGP (value
))
2138 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2142 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2143 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2145 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2146 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2148 /* Remove all scroll bars because they have wrong colors. */
2149 if (condemn_scroll_bars_hook
)
2150 (*condemn_scroll_bars_hook
) (f
);
2151 if (judge_scroll_bars_hook
)
2152 (*judge_scroll_bars_hook
) (f
);
2154 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2160 /* Encode Lisp string STRING as a text in a format appropriate for
2161 XICCC (X Inter Client Communication Conventions).
2163 If STRING contains only ASCII characters, do no conversion and
2164 return the string data of STRING. Otherwise, encode the text by
2165 CODING_SYSTEM, and return a newly allocated memory area which
2166 should be freed by `xfree' by a caller.
2168 Store the byte length of resulting text in *TEXT_BYTES.
2170 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
2171 which means that the `encoding' of the result can be `STRING'.
2172 Otherwise store 0 in *STRINGP, which means that the `encoding' of
2173 the result should be `COMPOUND_TEXT'. */
2176 x_encode_text (string
, coding_system
, text_bytes
, stringp
)
2177 Lisp_Object string
, coding_system
;
2178 int *text_bytes
, *stringp
;
2180 unsigned char *str
= XSTRING (string
)->data
;
2181 int chars
= XSTRING (string
)->size
;
2182 int bytes
= STRING_BYTES (XSTRING (string
));
2186 struct coding_system coding
;
2188 charset_info
= find_charset_in_text (str
, chars
, bytes
, NULL
, Qnil
);
2189 if (charset_info
== 0)
2191 /* No multibyte character in OBJ. We need not encode it. */
2192 *text_bytes
= bytes
;
2197 setup_coding_system (coding_system
, &coding
);
2198 coding
.src_multibyte
= 1;
2199 coding
.dst_multibyte
= 0;
2200 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
2201 if (coding
.type
== coding_type_iso2022
)
2202 coding
.flags
|= CODING_FLAG_ISO_SAFE
;
2203 /* We suppress producing escape sequences for composition. */
2204 coding
.composing
= COMPOSITION_DISABLED
;
2205 bufsize
= encoding_buffer_size (&coding
, bytes
);
2206 buf
= (unsigned char *) xmalloc (bufsize
);
2207 encode_coding (&coding
, str
, buf
, bytes
, bufsize
);
2208 *text_bytes
= coding
.produced
;
2209 *stringp
= (charset_info
== 1 || !EQ (coding_system
, Qcompound_text
));
2214 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2217 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2218 name; if NAME is a string, set F's name to NAME and set
2219 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2221 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2222 suggesting a new name, which lisp code should override; if
2223 F->explicit_name is set, ignore the new name; otherwise, set it. */
2226 x_set_name (f
, name
, explicit)
2231 /* Make sure that requests from lisp code override requests from
2232 Emacs redisplay code. */
2235 /* If we're switching from explicit to implicit, we had better
2236 update the mode lines and thereby update the title. */
2237 if (f
->explicit_name
&& NILP (name
))
2238 update_mode_lines
= 1;
2240 f
->explicit_name
= ! NILP (name
);
2242 else if (f
->explicit_name
)
2245 /* If NAME is nil, set the name to the x_id_name. */
2248 /* Check for no change needed in this very common case
2249 before we do any consing. */
2250 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2251 XSTRING (f
->name
)->data
))
2253 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2256 CHECK_STRING (name
, 0);
2258 /* Don't change the name if it's already NAME. */
2259 if (! NILP (Fstring_equal (name
, f
->name
)))
2264 /* For setting the frame title, the title parameter should override
2265 the name parameter. */
2266 if (! NILP (f
->title
))
2269 if (FRAME_X_WINDOW (f
))
2274 XTextProperty text
, icon
;
2276 Lisp_Object coding_system
;
2278 coding_system
= Vlocale_coding_system
;
2279 if (NILP (coding_system
))
2280 coding_system
= Qcompound_text
;
2281 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2282 text
.encoding
= (stringp
? XA_STRING
2283 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2285 text
.nitems
= bytes
;
2287 if (NILP (f
->icon_name
))
2293 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2295 icon
.encoding
= (stringp
? XA_STRING
2296 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2298 icon
.nitems
= bytes
;
2300 #ifdef USE_X_TOOLKIT
2301 XSetWMName (FRAME_X_DISPLAY (f
),
2302 XtWindow (f
->output_data
.x
->widget
), &text
);
2303 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2305 #else /* not USE_X_TOOLKIT */
2306 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2307 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2308 #endif /* not USE_X_TOOLKIT */
2309 if (!NILP (f
->icon_name
)
2310 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2312 if (text
.value
!= XSTRING (name
)->data
)
2315 #else /* not HAVE_X11R4 */
2316 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2317 XSTRING (name
)->data
);
2318 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2319 XSTRING (name
)->data
);
2320 #endif /* not HAVE_X11R4 */
2325 /* This function should be called when the user's lisp code has
2326 specified a name for the frame; the name will override any set by the
2329 x_explicitly_set_name (f
, arg
, oldval
)
2331 Lisp_Object arg
, oldval
;
2333 x_set_name (f
, arg
, 1);
2336 /* This function should be called by Emacs redisplay code to set the
2337 name; names set this way will never override names set by the user's
2340 x_implicitly_set_name (f
, arg
, oldval
)
2342 Lisp_Object arg
, oldval
;
2344 x_set_name (f
, arg
, 0);
2347 /* Change the title of frame F to NAME.
2348 If NAME is nil, use the frame name as the title.
2350 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2351 name; if NAME is a string, set F's name to NAME and set
2352 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2354 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2355 suggesting a new name, which lisp code should override; if
2356 F->explicit_name is set, ignore the new name; otherwise, set it. */
2359 x_set_title (f
, name
, old_name
)
2361 Lisp_Object name
, old_name
;
2363 /* Don't change the title if it's already NAME. */
2364 if (EQ (name
, f
->title
))
2367 update_mode_lines
= 1;
2374 CHECK_STRING (name
, 0);
2376 if (FRAME_X_WINDOW (f
))
2381 XTextProperty text
, icon
;
2383 Lisp_Object coding_system
;
2385 coding_system
= Vlocale_coding_system
;
2386 if (NILP (coding_system
))
2387 coding_system
= Qcompound_text
;
2388 text
.value
= x_encode_text (name
, coding_system
, &bytes
, &stringp
);
2389 text
.encoding
= (stringp
? XA_STRING
2390 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2392 text
.nitems
= bytes
;
2394 if (NILP (f
->icon_name
))
2400 icon
.value
= x_encode_text (f
->icon_name
, coding_system
,
2402 icon
.encoding
= (stringp
? XA_STRING
2403 : FRAME_X_DISPLAY_INFO (f
)->Xatom_COMPOUND_TEXT
);
2405 icon
.nitems
= bytes
;
2407 #ifdef USE_X_TOOLKIT
2408 XSetWMName (FRAME_X_DISPLAY (f
),
2409 XtWindow (f
->output_data
.x
->widget
), &text
);
2410 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2412 #else /* not USE_X_TOOLKIT */
2413 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2414 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2415 #endif /* not USE_X_TOOLKIT */
2416 if (!NILP (f
->icon_name
)
2417 && icon
.value
!= XSTRING (f
->icon_name
)->data
)
2419 if (text
.value
!= XSTRING (name
)->data
)
2422 #else /* not HAVE_X11R4 */
2423 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2424 XSTRING (name
)->data
);
2425 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2426 XSTRING (name
)->data
);
2427 #endif /* not HAVE_X11R4 */
2433 x_set_autoraise (f
, arg
, oldval
)
2435 Lisp_Object arg
, oldval
;
2437 f
->auto_raise
= !EQ (Qnil
, arg
);
2441 x_set_autolower (f
, arg
, oldval
)
2443 Lisp_Object arg
, oldval
;
2445 f
->auto_lower
= !EQ (Qnil
, arg
);
2449 x_set_unsplittable (f
, arg
, oldval
)
2451 Lisp_Object arg
, oldval
;
2453 f
->no_split
= !NILP (arg
);
2457 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2459 Lisp_Object arg
, oldval
;
2461 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2462 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2463 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2464 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2466 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2468 ? vertical_scroll_bar_none
2470 ? vertical_scroll_bar_right
2471 : vertical_scroll_bar_left
);
2473 /* We set this parameter before creating the X window for the
2474 frame, so we can get the geometry right from the start.
2475 However, if the window hasn't been created yet, we shouldn't
2476 call x_set_window_size. */
2477 if (FRAME_X_WINDOW (f
))
2478 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2479 do_pending_window_change (0);
2484 x_set_scroll_bar_width (f
, arg
, oldval
)
2486 Lisp_Object arg
, oldval
;
2488 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2492 #ifdef USE_TOOLKIT_SCROLL_BARS
2493 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2494 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2495 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2496 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2498 /* Make the actual width at least 14 pixels and a multiple of a
2500 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2502 /* Use all of that space (aside from required margins) for the
2504 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2507 if (FRAME_X_WINDOW (f
))
2508 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2509 do_pending_window_change (0);
2511 else if (INTEGERP (arg
) && XINT (arg
) > 0
2512 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2514 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2515 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2517 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2518 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2519 if (FRAME_X_WINDOW (f
))
2520 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2523 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2524 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2525 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2530 /* Subroutines of creating an X frame. */
2532 /* Make sure that Vx_resource_name is set to a reasonable value.
2533 Fix it up, or set it to `emacs' if it is too hopeless. */
2536 validate_x_resource_name ()
2539 /* Number of valid characters in the resource name. */
2541 /* Number of invalid characters in the resource name. */
2546 if (!STRINGP (Vx_resource_class
))
2547 Vx_resource_class
= build_string (EMACS_CLASS
);
2549 if (STRINGP (Vx_resource_name
))
2551 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2554 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2556 /* Only letters, digits, - and _ are valid in resource names.
2557 Count the valid characters and count the invalid ones. */
2558 for (i
= 0; i
< len
; i
++)
2561 if (! ((c
>= 'a' && c
<= 'z')
2562 || (c
>= 'A' && c
<= 'Z')
2563 || (c
>= '0' && c
<= '9')
2564 || c
== '-' || c
== '_'))
2571 /* Not a string => completely invalid. */
2572 bad_count
= 5, good_count
= 0;
2574 /* If name is valid already, return. */
2578 /* If name is entirely invalid, or nearly so, use `emacs'. */
2580 || (good_count
== 1 && bad_count
> 0))
2582 Vx_resource_name
= build_string ("emacs");
2586 /* Name is partly valid. Copy it and replace the invalid characters
2587 with underscores. */
2589 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2591 for (i
= 0; i
< len
; i
++)
2593 int c
= XSTRING (new)->data
[i
];
2594 if (! ((c
>= 'a' && c
<= 'z')
2595 || (c
>= 'A' && c
<= 'Z')
2596 || (c
>= '0' && c
<= '9')
2597 || c
== '-' || c
== '_'))
2598 XSTRING (new)->data
[i
] = '_';
2603 extern char *x_get_string_resource ();
2605 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2606 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2607 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2608 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2609 the name specified by the `-name' or `-rn' command-line arguments.\n\
2611 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2612 class, respectively. You must specify both of them or neither.\n\
2613 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2614 and the class is `Emacs.CLASS.SUBCLASS'.")
2615 (attribute
, class, component
, subclass
)
2616 Lisp_Object attribute
, class, component
, subclass
;
2618 register char *value
;
2624 CHECK_STRING (attribute
, 0);
2625 CHECK_STRING (class, 0);
2627 if (!NILP (component
))
2628 CHECK_STRING (component
, 1);
2629 if (!NILP (subclass
))
2630 CHECK_STRING (subclass
, 2);
2631 if (NILP (component
) != NILP (subclass
))
2632 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2634 validate_x_resource_name ();
2636 /* Allocate space for the components, the dots which separate them,
2637 and the final '\0'. Make them big enough for the worst case. */
2638 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2639 + (STRINGP (component
)
2640 ? STRING_BYTES (XSTRING (component
)) : 0)
2641 + STRING_BYTES (XSTRING (attribute
))
2644 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2645 + STRING_BYTES (XSTRING (class))
2646 + (STRINGP (subclass
)
2647 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2650 /* Start with emacs.FRAMENAME for the name (the specific one)
2651 and with `Emacs' for the class key (the general one). */
2652 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2653 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2655 strcat (class_key
, ".");
2656 strcat (class_key
, XSTRING (class)->data
);
2658 if (!NILP (component
))
2660 strcat (class_key
, ".");
2661 strcat (class_key
, XSTRING (subclass
)->data
);
2663 strcat (name_key
, ".");
2664 strcat (name_key
, XSTRING (component
)->data
);
2667 strcat (name_key
, ".");
2668 strcat (name_key
, XSTRING (attribute
)->data
);
2670 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2671 name_key
, class_key
);
2673 if (value
!= (char *) 0)
2674 return build_string (value
);
2679 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2682 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2683 struct x_display_info
*dpyinfo
;
2684 Lisp_Object attribute
, class, component
, subclass
;
2686 register char *value
;
2690 CHECK_STRING (attribute
, 0);
2691 CHECK_STRING (class, 0);
2693 if (!NILP (component
))
2694 CHECK_STRING (component
, 1);
2695 if (!NILP (subclass
))
2696 CHECK_STRING (subclass
, 2);
2697 if (NILP (component
) != NILP (subclass
))
2698 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2700 validate_x_resource_name ();
2702 /* Allocate space for the components, the dots which separate them,
2703 and the final '\0'. Make them big enough for the worst case. */
2704 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2705 + (STRINGP (component
)
2706 ? STRING_BYTES (XSTRING (component
)) : 0)
2707 + STRING_BYTES (XSTRING (attribute
))
2710 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2711 + STRING_BYTES (XSTRING (class))
2712 + (STRINGP (subclass
)
2713 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2716 /* Start with emacs.FRAMENAME for the name (the specific one)
2717 and with `Emacs' for the class key (the general one). */
2718 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2719 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2721 strcat (class_key
, ".");
2722 strcat (class_key
, XSTRING (class)->data
);
2724 if (!NILP (component
))
2726 strcat (class_key
, ".");
2727 strcat (class_key
, XSTRING (subclass
)->data
);
2729 strcat (name_key
, ".");
2730 strcat (name_key
, XSTRING (component
)->data
);
2733 strcat (name_key
, ".");
2734 strcat (name_key
, XSTRING (attribute
)->data
);
2736 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2738 if (value
!= (char *) 0)
2739 return build_string (value
);
2744 /* Used when C code wants a resource value. */
2747 x_get_resource_string (attribute
, class)
2748 char *attribute
, *class;
2752 struct frame
*sf
= SELECTED_FRAME ();
2754 /* Allocate space for the components, the dots which separate them,
2755 and the final '\0'. */
2756 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2757 + strlen (attribute
) + 2);
2758 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2759 + strlen (class) + 2);
2761 sprintf (name_key
, "%s.%s",
2762 XSTRING (Vinvocation_name
)->data
,
2764 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2766 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2767 name_key
, class_key
);
2770 /* Types we might convert a resource string into. */
2780 /* Return the value of parameter PARAM.
2782 First search ALIST, then Vdefault_frame_alist, then the X defaults
2783 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2785 Convert the resource to the type specified by desired_type.
2787 If no default is specified, return Qunbound. If you call
2788 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2789 and don't let it get stored in any Lisp-visible variables! */
2792 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2793 struct x_display_info
*dpyinfo
;
2794 Lisp_Object alist
, param
;
2797 enum resource_types type
;
2799 register Lisp_Object tem
;
2801 tem
= Fassq (param
, alist
);
2803 tem
= Fassq (param
, Vdefault_frame_alist
);
2809 tem
= display_x_get_resource (dpyinfo
,
2810 build_string (attribute
),
2811 build_string (class),
2819 case RES_TYPE_NUMBER
:
2820 return make_number (atoi (XSTRING (tem
)->data
));
2822 case RES_TYPE_FLOAT
:
2823 return make_float (atof (XSTRING (tem
)->data
));
2825 case RES_TYPE_BOOLEAN
:
2826 tem
= Fdowncase (tem
);
2827 if (!strcmp (XSTRING (tem
)->data
, "on")
2828 || !strcmp (XSTRING (tem
)->data
, "true"))
2833 case RES_TYPE_STRING
:
2836 case RES_TYPE_SYMBOL
:
2837 /* As a special case, we map the values `true' and `on'
2838 to Qt, and `false' and `off' to Qnil. */
2841 lower
= Fdowncase (tem
);
2842 if (!strcmp (XSTRING (lower
)->data
, "on")
2843 || !strcmp (XSTRING (lower
)->data
, "true"))
2845 else if (!strcmp (XSTRING (lower
)->data
, "off")
2846 || !strcmp (XSTRING (lower
)->data
, "false"))
2849 return Fintern (tem
, Qnil
);
2862 /* Like x_get_arg, but also record the value in f->param_alist. */
2865 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2867 Lisp_Object alist
, param
;
2870 enum resource_types type
;
2874 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2875 attribute
, class, type
);
2877 store_frame_param (f
, param
, value
);
2882 /* Record in frame F the specified or default value according to ALIST
2883 of the parameter named PROP (a Lisp symbol).
2884 If no value is specified for PROP, look for an X default for XPROP
2885 on the frame named NAME.
2886 If that is not found either, use the value DEFLT. */
2889 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2896 enum resource_types type
;
2900 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2901 if (EQ (tem
, Qunbound
))
2903 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2908 /* Record in frame F the specified or default value according to ALIST
2909 of the parameter named PROP (a Lisp symbol). If no value is
2910 specified for PROP, look for an X default for XPROP on the frame
2911 named NAME. If that is not found either, use the value DEFLT. */
2914 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2923 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2926 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2927 if (EQ (tem
, Qunbound
))
2929 #ifdef USE_TOOLKIT_SCROLL_BARS
2931 /* See if an X resource for the scroll bar color has been
2933 tem
= display_x_get_resource (dpyinfo
,
2934 build_string (foreground_p
2938 build_string ("verticalScrollBar"),
2942 /* If nothing has been specified, scroll bars will use a
2943 toolkit-dependent default. Because these defaults are
2944 difficult to get at without actually creating a scroll
2945 bar, use nil to indicate that no color has been
2950 #else /* not USE_TOOLKIT_SCROLL_BARS */
2954 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2957 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2963 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2964 "Parse an X-style geometry string STRING.\n\
2965 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2966 The properties returned may include `top', `left', `height', and `width'.\n\
2967 The value of `left' or `top' may be an integer,\n\
2968 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2969 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2974 unsigned int width
, height
;
2977 CHECK_STRING (string
, 0);
2979 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2980 &x
, &y
, &width
, &height
);
2983 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2984 error ("Must specify both x and y position, or neither");
2988 if (geometry
& XValue
)
2990 Lisp_Object element
;
2992 if (x
>= 0 && (geometry
& XNegative
))
2993 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2994 else if (x
< 0 && ! (geometry
& XNegative
))
2995 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2997 element
= Fcons (Qleft
, make_number (x
));
2998 result
= Fcons (element
, result
);
3001 if (geometry
& YValue
)
3003 Lisp_Object element
;
3005 if (y
>= 0 && (geometry
& YNegative
))
3006 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
3007 else if (y
< 0 && ! (geometry
& YNegative
))
3008 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
3010 element
= Fcons (Qtop
, make_number (y
));
3011 result
= Fcons (element
, result
);
3014 if (geometry
& WidthValue
)
3015 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
3016 if (geometry
& HeightValue
)
3017 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
3022 /* Calculate the desired size and position of this window,
3023 and return the flags saying which aspects were specified.
3025 This function does not make the coordinates positive. */
3027 #define DEFAULT_ROWS 40
3028 #define DEFAULT_COLS 80
3031 x_figure_window_size (f
, parms
)
3035 register Lisp_Object tem0
, tem1
, tem2
;
3036 long window_prompting
= 0;
3037 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3039 /* Default values if we fall through.
3040 Actually, if that happens we should get
3041 window manager prompting. */
3042 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
3043 f
->height
= DEFAULT_ROWS
;
3044 /* Window managers expect that if program-specified
3045 positions are not (0,0), they're intentional, not defaults. */
3046 f
->output_data
.x
->top_pos
= 0;
3047 f
->output_data
.x
->left_pos
= 0;
3049 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
3050 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
3051 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
3052 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3054 if (!EQ (tem0
, Qunbound
))
3056 CHECK_NUMBER (tem0
, 0);
3057 f
->height
= XINT (tem0
);
3059 if (!EQ (tem1
, Qunbound
))
3061 CHECK_NUMBER (tem1
, 0);
3062 SET_FRAME_WIDTH (f
, XINT (tem1
));
3064 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
3065 window_prompting
|= USSize
;
3067 window_prompting
|= PSize
;
3070 f
->output_data
.x
->vertical_scroll_bar_extra
3071 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
3073 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
3074 f
->output_data
.x
->flags_areas_extra
3075 = FRAME_FLAGS_AREA_WIDTH (f
);
3076 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
3077 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
3079 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
3080 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
3081 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
3082 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
3084 if (EQ (tem0
, Qminus
))
3086 f
->output_data
.x
->top_pos
= 0;
3087 window_prompting
|= YNegative
;
3089 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
3090 && CONSP (XCDR (tem0
))
3091 && INTEGERP (XCAR (XCDR (tem0
))))
3093 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
3094 window_prompting
|= YNegative
;
3096 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
3097 && CONSP (XCDR (tem0
))
3098 && INTEGERP (XCAR (XCDR (tem0
))))
3100 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
3102 else if (EQ (tem0
, Qunbound
))
3103 f
->output_data
.x
->top_pos
= 0;
3106 CHECK_NUMBER (tem0
, 0);
3107 f
->output_data
.x
->top_pos
= XINT (tem0
);
3108 if (f
->output_data
.x
->top_pos
< 0)
3109 window_prompting
|= YNegative
;
3112 if (EQ (tem1
, Qminus
))
3114 f
->output_data
.x
->left_pos
= 0;
3115 window_prompting
|= XNegative
;
3117 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
3118 && CONSP (XCDR (tem1
))
3119 && INTEGERP (XCAR (XCDR (tem1
))))
3121 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
3122 window_prompting
|= XNegative
;
3124 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
3125 && CONSP (XCDR (tem1
))
3126 && INTEGERP (XCAR (XCDR (tem1
))))
3128 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
3130 else if (EQ (tem1
, Qunbound
))
3131 f
->output_data
.x
->left_pos
= 0;
3134 CHECK_NUMBER (tem1
, 0);
3135 f
->output_data
.x
->left_pos
= XINT (tem1
);
3136 if (f
->output_data
.x
->left_pos
< 0)
3137 window_prompting
|= XNegative
;
3140 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
3141 window_prompting
|= USPosition
;
3143 window_prompting
|= PPosition
;
3146 return window_prompting
;
3149 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3152 XSetWMProtocols (dpy
, w
, protocols
, count
)
3159 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
3160 if (prop
== None
) return False
;
3161 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
3162 (unsigned char *) protocols
, count
);
3165 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3167 #ifdef USE_X_TOOLKIT
3169 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3170 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3171 already be present because of the toolkit (Motif adds some of them,
3172 for example, but Xt doesn't). */
3175 hack_wm_protocols (f
, widget
)
3179 Display
*dpy
= XtDisplay (widget
);
3180 Window w
= XtWindow (widget
);
3181 int need_delete
= 1;
3187 Atom type
, *atoms
= 0;
3189 unsigned long nitems
= 0;
3190 unsigned long bytes_after
;
3192 if ((XGetWindowProperty (dpy
, w
,
3193 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3194 (long)0, (long)100, False
, XA_ATOM
,
3195 &type
, &format
, &nitems
, &bytes_after
,
3196 (unsigned char **) &atoms
)
3198 && format
== 32 && type
== XA_ATOM
)
3202 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3204 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3206 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3209 if (atoms
) XFree ((char *) atoms
);
3215 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3217 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3219 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3221 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3222 XA_ATOM
, 32, PropModeAppend
,
3223 (unsigned char *) props
, count
);
3231 /* Support routines for XIC (X Input Context). */
3235 static XFontSet xic_create_xfontset
P_ ((struct frame
*, char *));
3236 static XIMStyle best_xim_style
P_ ((XIMStyles
*, XIMStyles
*));
3239 /* Supported XIM styles, ordered by preferenc. */
3241 static XIMStyle supported_xim_styles
[] =
3243 XIMPreeditPosition
| XIMStatusArea
,
3244 XIMPreeditPosition
| XIMStatusNothing
,
3245 XIMPreeditPosition
| XIMStatusNone
,
3246 XIMPreeditNothing
| XIMStatusArea
,
3247 XIMPreeditNothing
| XIMStatusNothing
,
3248 XIMPreeditNothing
| XIMStatusNone
,
3249 XIMPreeditNone
| XIMStatusArea
,
3250 XIMPreeditNone
| XIMStatusNothing
,
3251 XIMPreeditNone
| XIMStatusNone
,
3256 /* Create an X fontset on frame F with base font name
3260 xic_create_xfontset (f
, base_fontname
)
3262 char *base_fontname
;
3265 char **missing_list
;
3269 xfs
= XCreateFontSet (FRAME_X_DISPLAY (f
),
3270 base_fontname
, &missing_list
,
3271 &missing_count
, &def_string
);
3273 XFreeStringList (missing_list
);
3275 /* No need to free def_string. */
3280 /* Value is the best input style, given user preferences USER (already
3281 checked to be supported by Emacs), and styles supported by the
3282 input method XIM. */
3285 best_xim_style (user
, xim
)
3291 for (i
= 0; i
< user
->count_styles
; ++i
)
3292 for (j
= 0; j
< xim
->count_styles
; ++j
)
3293 if (user
->supported_styles
[i
] == xim
->supported_styles
[j
])
3294 return user
->supported_styles
[i
];
3296 /* Return the default style. */
3297 return XIMPreeditNothing
| XIMStatusNothing
;
3300 /* Create XIC for frame F. */
3303 create_frame_xic (f
)
3308 XFontSet xfs
= NULL
;
3309 static XIMStyle xic_style
;
3314 xim
= FRAME_X_XIM (f
);
3319 XVaNestedList preedit_attr
;
3320 XVaNestedList status_attr
;
3321 char *base_fontname
;
3324 s_area
.x
= 0; s_area
.y
= 0; s_area
.width
= 1; s_area
.height
= 1;
3325 spot
.x
= 0; spot
.y
= 1;
3326 /* Create X fontset. */
3327 fontset
= FRAME_FONTSET (f
);
3329 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3332 /* Determine the base fontname from the ASCII font name of
3334 char *ascii_font
= (char *) XSTRING (fontset_ascii (fontset
))->data
;
3335 char *p
= ascii_font
;
3338 for (i
= 0; *p
; p
++)
3341 /* As the font name doesn't conform to XLFD, we can't
3342 modify it to get a suitable base fontname for the
3344 base_fontname
= "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3347 int len
= strlen (ascii_font
) + 1;
3350 for (i
= 0, p
= ascii_font
; i
< 8; p
++)
3359 base_fontname
= (char *) alloca (len
);
3360 bzero (base_fontname
, len
);
3361 strcpy (base_fontname
, "-*-*-");
3362 bcopy (p1
, base_fontname
+ 5, p
- p1
);
3363 strcat (base_fontname
, "*-*-*-*-*-*-*");
3366 xfs
= xic_create_xfontset (f
, base_fontname
);
3368 /* Determine XIC style. */
3371 XIMStyles supported_list
;
3372 supported_list
.count_styles
= (sizeof supported_xim_styles
3373 / sizeof supported_xim_styles
[0]);
3374 supported_list
.supported_styles
= supported_xim_styles
;
3375 xic_style
= best_xim_style (&supported_list
,
3376 FRAME_X_XIM_STYLES (f
));
3379 preedit_attr
= XVaCreateNestedList (0,
3382 FRAME_FOREGROUND_PIXEL (f
),
3384 FRAME_BACKGROUND_PIXEL (f
),
3385 (xic_style
& XIMPreeditPosition
3390 status_attr
= XVaCreateNestedList (0,
3396 FRAME_FOREGROUND_PIXEL (f
),
3398 FRAME_BACKGROUND_PIXEL (f
),
3401 xic
= XCreateIC (xim
,
3402 XNInputStyle
, xic_style
,
3403 XNClientWindow
, FRAME_X_WINDOW(f
),
3404 XNFocusWindow
, FRAME_X_WINDOW(f
),
3405 XNStatusAttributes
, status_attr
,
3406 XNPreeditAttributes
, preedit_attr
,
3408 XFree (preedit_attr
);
3409 XFree (status_attr
);
3412 FRAME_XIC (f
) = xic
;
3413 FRAME_XIC_STYLE (f
) = xic_style
;
3414 FRAME_XIC_FONTSET (f
) = xfs
;
3418 /* Destroy XIC and free XIC fontset of frame F, if any. */
3424 if (FRAME_XIC (f
) == NULL
)
3427 XDestroyIC (FRAME_XIC (f
));
3428 if (FRAME_XIC_FONTSET (f
))
3429 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3431 FRAME_XIC (f
) = NULL
;
3432 FRAME_XIC_FONTSET (f
) = NULL
;
3436 /* Place preedit area for XIC of window W's frame to specified
3437 pixel position X/Y. X and Y are relative to window W. */
3440 xic_set_preeditarea (w
, x
, y
)
3444 struct frame
*f
= XFRAME (w
->frame
);
3448 spot
.x
= WINDOW_TO_FRAME_PIXEL_X (w
, x
);
3449 spot
.y
= WINDOW_TO_FRAME_PIXEL_Y (w
, y
) + FONT_BASE (FRAME_FONT (f
));
3450 attr
= XVaCreateNestedList (0, XNSpotLocation
, &spot
, NULL
);
3451 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3456 /* Place status area for XIC in bottom right corner of frame F.. */
3459 xic_set_statusarea (f
)
3462 XIC xic
= FRAME_XIC (f
);
3467 /* Negotiate geometry of status area. If input method has existing
3468 status area, use its current size. */
3469 area
.x
= area
.y
= area
.width
= area
.height
= 0;
3470 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &area
, NULL
);
3471 XSetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3474 attr
= XVaCreateNestedList (0, XNAreaNeeded
, &needed
, NULL
);
3475 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3478 if (needed
->width
== 0) /* Use XNArea instead of XNAreaNeeded */
3480 attr
= XVaCreateNestedList (0, XNArea
, &needed
, NULL
);
3481 XGetICValues (xic
, XNStatusAttributes
, attr
, NULL
);
3485 area
.width
= needed
->width
;
3486 area
.height
= needed
->height
;
3487 area
.x
= PIXEL_WIDTH (f
) - area
.width
- FRAME_INTERNAL_BORDER_WIDTH (f
);
3488 area
.y
= (PIXEL_HEIGHT (f
) - area
.height
3489 - FRAME_MENUBAR_HEIGHT (f
) - FRAME_INTERNAL_BORDER_WIDTH (f
));
3492 attr
= XVaCreateNestedList (0, XNArea
, &area
, NULL
);
3493 XSetICValues(xic
, XNStatusAttributes
, attr
, NULL
);
3498 /* Set X fontset for XIC of frame F, using base font name
3499 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3502 xic_set_xfontset (f
, base_fontname
)
3504 char *base_fontname
;
3509 xfs
= xic_create_xfontset (f
, base_fontname
);
3511 attr
= XVaCreateNestedList (0, XNFontSet
, xfs
, NULL
);
3512 if (FRAME_XIC_STYLE (f
) & XIMPreeditPosition
)
3513 XSetICValues (FRAME_XIC (f
), XNPreeditAttributes
, attr
, NULL
);
3514 if (FRAME_XIC_STYLE (f
) & XIMStatusArea
)
3515 XSetICValues (FRAME_XIC (f
), XNStatusAttributes
, attr
, NULL
);
3518 if (FRAME_XIC_FONTSET (f
))
3519 XFreeFontSet (FRAME_X_DISPLAY (f
), FRAME_XIC_FONTSET (f
));
3520 FRAME_XIC_FONTSET (f
) = xfs
;
3523 #endif /* HAVE_X_I18N */
3527 #ifdef USE_X_TOOLKIT
3529 /* Create and set up the X widget for frame F. */
3532 x_window (f
, window_prompting
, minibuffer_only
)
3534 long window_prompting
;
3535 int minibuffer_only
;
3537 XClassHint class_hints
;
3538 XSetWindowAttributes attributes
;
3539 unsigned long attribute_mask
;
3540 Widget shell_widget
;
3542 Widget frame_widget
;
3548 /* Use the resource name as the top-level widget name
3549 for looking up resources. Make a non-Lisp copy
3550 for the window manager, so GC relocation won't bother it.
3552 Elsewhere we specify the window name for the window manager. */
3555 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3556 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3557 strcpy (f
->namebuf
, str
);
3561 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3562 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3563 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3564 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3565 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3566 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3567 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3568 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3569 applicationShellWidgetClass
,
3570 FRAME_X_DISPLAY (f
), al
, ac
);
3572 f
->output_data
.x
->widget
= shell_widget
;
3573 /* maybe_set_screen_title_format (shell_widget); */
3575 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3576 (widget_value
*) NULL
,
3577 shell_widget
, False
,
3581 (lw_callback
) NULL
);
3584 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3585 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3586 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3587 XtSetValues (pane_widget
, al
, ac
);
3588 f
->output_data
.x
->column_widget
= pane_widget
;
3590 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3591 the emacs screen when changing menubar. This reduces flickering. */
3594 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3595 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3596 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3597 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3598 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3599 XtSetArg (al
[ac
], XtNvisual
, FRAME_X_VISUAL (f
)); ac
++;
3600 XtSetArg (al
[ac
], XtNdepth
, FRAME_X_DISPLAY_INFO (f
)->n_planes
); ac
++;
3601 XtSetArg (al
[ac
], XtNcolormap
, FRAME_X_COLORMAP (f
)); ac
++;
3602 frame_widget
= XtCreateWidget (f
->namebuf
, emacsFrameClass
, pane_widget
,
3605 f
->output_data
.x
->edit_widget
= frame_widget
;
3607 XtManageChild (frame_widget
);
3609 /* Do some needed geometry management. */
3612 char *tem
, shell_position
[32];
3615 int extra_borders
= 0;
3617 = (f
->output_data
.x
->menubar_widget
3618 ? (f
->output_data
.x
->menubar_widget
->core
.height
3619 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3622 #if 0 /* Experimentally, we now get the right results
3623 for -geometry -0-0 without this. 24 Aug 96, rms. */
3624 if (FRAME_EXTERNAL_MENU_BAR (f
))
3627 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3628 menubar_size
+= ibw
;
3632 f
->output_data
.x
->menubar_height
= menubar_size
;
3635 /* Motif seems to need this amount added to the sizes
3636 specified for the shell widget. The Athena/Lucid widgets don't.
3637 Both conclusions reached experimentally. -- rms. */
3638 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3639 &extra_borders
, NULL
);
3643 /* Convert our geometry parameters into a geometry string
3645 Note that we do not specify here whether the position
3646 is a user-specified or program-specified one.
3647 We pass that information later, in x_wm_set_size_hints. */
3649 int left
= f
->output_data
.x
->left_pos
;
3650 int xneg
= window_prompting
& XNegative
;
3651 int top
= f
->output_data
.x
->top_pos
;
3652 int yneg
= window_prompting
& YNegative
;
3658 if (window_prompting
& USPosition
)
3659 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3660 PIXEL_WIDTH (f
) + extra_borders
,
3661 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3662 (xneg
? '-' : '+'), left
,
3663 (yneg
? '-' : '+'), top
);
3665 sprintf (shell_position
, "=%dx%d",
3666 PIXEL_WIDTH (f
) + extra_borders
,
3667 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3670 len
= strlen (shell_position
) + 1;
3671 /* We don't free this because we don't know whether
3672 it is safe to free it while the frame exists.
3673 It isn't worth the trouble of arranging to free it
3674 when the frame is deleted. */
3675 tem
= (char *) xmalloc (len
);
3676 strncpy (tem
, shell_position
, len
);
3677 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3678 XtSetValues (shell_widget
, al
, ac
);
3681 XtManageChild (pane_widget
);
3682 XtRealizeWidget (shell_widget
);
3684 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3686 validate_x_resource_name ();
3688 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3689 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3690 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3693 FRAME_XIC (f
) = NULL
;
3695 create_frame_xic (f
);
3699 f
->output_data
.x
->wm_hints
.input
= True
;
3700 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3701 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3702 &f
->output_data
.x
->wm_hints
);
3704 hack_wm_protocols (f
, shell_widget
);
3707 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3710 /* Do a stupid property change to force the server to generate a
3711 PropertyNotify event so that the event_stream server timestamp will
3712 be initialized to something relevant to the time we created the window.
3714 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3715 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3716 XA_ATOM
, 32, PropModeAppend
,
3717 (unsigned char*) NULL
, 0);
3719 /* Make all the standard events reach the Emacs frame. */
3720 attributes
.event_mask
= STANDARD_EVENT_SET
;
3725 /* XIM server might require some X events. */
3726 unsigned long fevent
= NoEventMask
;
3727 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3728 attributes
.event_mask
|= fevent
;
3730 #endif /* HAVE_X_I18N */
3732 attribute_mask
= CWEventMask
;
3733 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3734 attribute_mask
, &attributes
);
3736 XtMapWidget (frame_widget
);
3738 /* x_set_name normally ignores requests to set the name if the
3739 requested name is the same as the current name. This is the one
3740 place where that assumption isn't correct; f->name is set, but
3741 the X server hasn't been told. */
3744 int explicit = f
->explicit_name
;
3746 f
->explicit_name
= 0;
3749 x_set_name (f
, name
, explicit);
3752 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3753 f
->output_data
.x
->text_cursor
);
3757 /* This is a no-op, except under Motif. Make sure main areas are
3758 set to something reasonable, in case we get an error later. */
3759 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3762 #else /* not USE_X_TOOLKIT */
3764 /* Create and set up the X window for frame F. */
3771 XClassHint class_hints
;
3772 XSetWindowAttributes attributes
;
3773 unsigned long attribute_mask
;
3775 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3776 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3777 attributes
.bit_gravity
= StaticGravity
;
3778 attributes
.backing_store
= NotUseful
;
3779 attributes
.save_under
= True
;
3780 attributes
.event_mask
= STANDARD_EVENT_SET
;
3781 attributes
.colormap
= FRAME_X_COLORMAP (f
);
3782 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
| CWEventMask
3787 = XCreateWindow (FRAME_X_DISPLAY (f
),
3788 f
->output_data
.x
->parent_desc
,
3789 f
->output_data
.x
->left_pos
,
3790 f
->output_data
.x
->top_pos
,
3791 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3792 f
->output_data
.x
->border_width
,
3793 CopyFromParent
, /* depth */
3794 InputOutput
, /* class */
3796 attribute_mask
, &attributes
);
3800 create_frame_xic (f
);
3803 /* XIM server might require some X events. */
3804 unsigned long fevent
= NoEventMask
;
3805 XGetICValues(FRAME_XIC (f
), XNFilterEvents
, &fevent
, NULL
);
3806 attributes
.event_mask
|= fevent
;
3807 attribute_mask
= CWEventMask
;
3808 XChangeWindowAttributes (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3809 attribute_mask
, &attributes
);
3812 #endif /* HAVE_X_I18N */
3814 validate_x_resource_name ();
3816 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3817 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3818 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3820 /* The menubar is part of the ordinary display;
3821 it does not count in addition to the height of the window. */
3822 f
->output_data
.x
->menubar_height
= 0;
3824 /* This indicates that we use the "Passive Input" input model.
3825 Unless we do this, we don't get the Focus{In,Out} events that we
3826 need to draw the cursor correctly. Accursed bureaucrats.
3827 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3829 f
->output_data
.x
->wm_hints
.input
= True
;
3830 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3831 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3832 &f
->output_data
.x
->wm_hints
);
3833 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3835 /* Request "save yourself" and "delete window" commands from wm. */
3838 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3839 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3840 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3843 /* x_set_name normally ignores requests to set the name if the
3844 requested name is the same as the current name. This is the one
3845 place where that assumption isn't correct; f->name is set, but
3846 the X server hasn't been told. */
3849 int explicit = f
->explicit_name
;
3851 f
->explicit_name
= 0;
3854 x_set_name (f
, name
, explicit);
3857 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3858 f
->output_data
.x
->text_cursor
);
3862 if (FRAME_X_WINDOW (f
) == 0)
3863 error ("Unable to create window");
3866 #endif /* not USE_X_TOOLKIT */
3868 /* Handle the icon stuff for this window. Perhaps later we might
3869 want an x_set_icon_position which can be called interactively as
3877 Lisp_Object icon_x
, icon_y
;
3878 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3880 /* Set the position of the icon. Note that twm groups all
3881 icons in an icon window. */
3882 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3883 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3884 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3886 CHECK_NUMBER (icon_x
, 0);
3887 CHECK_NUMBER (icon_y
, 0);
3889 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3890 error ("Both left and top icon corners of icon must be specified");
3894 if (! EQ (icon_x
, Qunbound
))
3895 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3897 /* Start up iconic or window? */
3898 x_wm_set_window_state
3899 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3904 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3911 /* Make the GCs needed for this window, setting the
3912 background, border and mouse colors; also create the
3913 mouse cursor and the gray border tile. */
3915 static char cursor_bits
[] =
3917 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3918 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3919 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3920 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3927 XGCValues gc_values
;
3931 /* Create the GCs of this frame.
3932 Note that many default values are used. */
3935 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3936 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3937 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3938 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3939 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3941 GCLineWidth
| GCFont
3942 | GCForeground
| GCBackground
,
3945 /* Reverse video style. */
3946 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3947 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3948 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3950 GCFont
| GCForeground
| GCBackground
3954 /* Cursor has cursor-color background, background-color foreground. */
3955 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3956 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3957 gc_values
.fill_style
= FillOpaqueStippled
;
3959 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3960 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3961 cursor_bits
, 16, 16);
3962 f
->output_data
.x
->cursor_gc
3963 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3964 (GCFont
| GCForeground
| GCBackground
3965 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3969 f
->output_data
.x
->white_relief
.gc
= 0;
3970 f
->output_data
.x
->black_relief
.gc
= 0;
3972 /* Create the gray border tile used when the pointer is not in
3973 the frame. Since this depends on the frame's pixel values,
3974 this must be done on a per-frame basis. */
3975 f
->output_data
.x
->border_tile
3976 = (XCreatePixmapFromBitmapData
3977 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3978 gray_bits
, gray_width
, gray_height
,
3979 f
->output_data
.x
->foreground_pixel
,
3980 f
->output_data
.x
->background_pixel
,
3981 DefaultDepth (FRAME_X_DISPLAY (f
),
3982 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3987 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3989 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3990 Returns an Emacs frame object.\n\
3991 ALIST is an alist of frame parameters.\n\
3992 If the parameters specify that the frame should not have a minibuffer,\n\
3993 and do not specify a specific minibuffer window to use,\n\
3994 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3995 be shared by the new frame.\n\
3997 This function is an internal primitive--use `make-frame' instead.")
4002 Lisp_Object frame
, tem
;
4004 int minibuffer_only
= 0;
4005 long window_prompting
= 0;
4007 int count
= specpdl_ptr
- specpdl
;
4008 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4009 Lisp_Object display
;
4010 struct x_display_info
*dpyinfo
= NULL
;
4016 /* Use this general default value to start with
4017 until we know if this frame has a specified name. */
4018 Vx_resource_name
= Vinvocation_name
;
4020 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4021 if (EQ (display
, Qunbound
))
4023 dpyinfo
= check_x_display_info (display
);
4025 kb
= dpyinfo
->kboard
;
4027 kb
= &the_only_kboard
;
4030 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
4032 && ! EQ (name
, Qunbound
)
4034 error ("Invalid frame name--not a string or nil");
4037 Vx_resource_name
= name
;
4039 /* See if parent window is specified. */
4040 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4041 if (EQ (parent
, Qunbound
))
4043 if (! NILP (parent
))
4044 CHECK_NUMBER (parent
, 0);
4046 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4047 /* No need to protect DISPLAY because that's not used after passing
4048 it to make_frame_without_minibuffer. */
4050 GCPRO4 (parms
, parent
, name
, frame
);
4051 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
4053 if (EQ (tem
, Qnone
) || NILP (tem
))
4054 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4055 else if (EQ (tem
, Qonly
))
4057 f
= make_minibuffer_frame ();
4058 minibuffer_only
= 1;
4060 else if (WINDOWP (tem
))
4061 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4065 XSETFRAME (frame
, f
);
4067 /* Note that X Windows does support scroll bars. */
4068 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4070 f
->output_method
= output_x_window
;
4071 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
4072 bzero (f
->output_data
.x
, sizeof (struct x_output
));
4073 f
->output_data
.x
->icon_bitmap
= -1;
4074 f
->output_data
.x
->fontset
= -1;
4075 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
4076 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
4079 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
4081 if (! STRINGP (f
->icon_name
))
4082 f
->icon_name
= Qnil
;
4084 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
4086 FRAME_KBOARD (f
) = kb
;
4089 /* These colors will be set anyway later, but it's important
4090 to get the color reference counts right, so initialize them! */
4093 struct gcpro gcpro1
;
4095 black
= build_string ("black");
4097 f
->output_data
.x
->foreground_pixel
4098 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4099 f
->output_data
.x
->background_pixel
4100 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4101 f
->output_data
.x
->cursor_pixel
4102 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4103 f
->output_data
.x
->cursor_foreground_pixel
4104 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4105 f
->output_data
.x
->border_pixel
4106 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4107 f
->output_data
.x
->mouse_pixel
4108 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
4112 /* Specify the parent under which to make this X window. */
4116 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
4117 f
->output_data
.x
->explicit_parent
= 1;
4121 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4122 f
->output_data
.x
->explicit_parent
= 0;
4125 /* Set the name; the functions to which we pass f expect the name to
4127 if (EQ (name
, Qunbound
) || NILP (name
))
4129 f
->name
= build_string (dpyinfo
->x_id_name
);
4130 f
->explicit_name
= 0;
4135 f
->explicit_name
= 1;
4136 /* use the frame's title when getting resources for this frame. */
4137 specbind (Qx_resource_name
, name
);
4140 /* Extract the window parameters from the supplied values
4141 that are needed to determine window geometry. */
4145 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4148 /* First, try whatever font the caller has specified. */
4151 tem
= Fquery_fontset (font
, Qnil
);
4153 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4155 font
= x_new_font (f
, XSTRING (font
)->data
);
4158 /* Try out a font which we hope has bold and italic variations. */
4159 if (!STRINGP (font
))
4160 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
4161 if (!STRINGP (font
))
4162 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4163 if (! STRINGP (font
))
4164 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
4165 if (! STRINGP (font
))
4166 /* This was formerly the first thing tried, but it finds too many fonts
4167 and takes too long. */
4168 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4169 /* If those didn't work, look for something which will at least work. */
4170 if (! STRINGP (font
))
4171 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
4173 if (! STRINGP (font
))
4174 font
= build_string ("fixed");
4176 x_default_parameter (f
, parms
, Qfont
, font
,
4177 "font", "Font", RES_TYPE_STRING
);
4181 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4182 whereby it fails to get any font. */
4183 xlwmenu_default_font
= f
->output_data
.x
->font
;
4186 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4187 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4189 /* This defaults to 2 in order to match xterm. We recognize either
4190 internalBorderWidth or internalBorder (which is what xterm calls
4192 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4196 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
4197 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
4198 if (! EQ (value
, Qunbound
))
4199 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4202 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
4203 "internalBorderWidth", "internalBorderWidth",
4205 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
4206 "verticalScrollBars", "ScrollBars",
4209 /* Also do the stuff which must be set before the window exists. */
4210 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4211 "foreground", "Foreground", RES_TYPE_STRING
);
4212 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4213 "background", "Background", RES_TYPE_STRING
);
4214 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4215 "pointerColor", "Foreground", RES_TYPE_STRING
);
4216 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4217 "cursorColor", "Foreground", RES_TYPE_STRING
);
4218 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4219 "borderColor", "BorderColor", RES_TYPE_STRING
);
4220 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
4221 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4222 x_default_parameter (f
, parms
, Qline_spacing
, Qnil
,
4223 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4225 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
4226 "scrollBarForeground",
4227 "ScrollBarForeground", 1);
4228 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
4229 "scrollBarBackground",
4230 "ScrollBarBackground", 0);
4232 /* Init faces before x_default_parameter is called for scroll-bar
4233 parameters because that function calls x_set_scroll_bar_width,
4234 which calls change_frame_size, which calls Fset_window_buffer,
4235 which runs hooks, which call Fvertical_motion. At the end, we
4236 end up in init_iterator with a null face cache, which should not
4238 init_frame_faces (f
);
4240 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4241 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4242 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (1),
4243 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4244 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4245 "bufferPredicate", "BufferPredicate",
4247 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4248 "title", "Title", RES_TYPE_STRING
);
4250 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
4251 window_prompting
= x_figure_window_size (f
, parms
);
4253 if (window_prompting
& XNegative
)
4255 if (window_prompting
& YNegative
)
4256 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
4258 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
4262 if (window_prompting
& YNegative
)
4263 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
4265 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
4268 f
->output_data
.x
->size_hint_flags
= window_prompting
;
4270 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4271 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4273 /* Create the X widget or window. Add the tool-bar height to the
4274 initial frame height so that the user gets a text display area of
4275 the size he specified with -g or via .Xdefaults. Later changes
4276 of the tool-bar height don't change the frame size. This is done
4277 so that users can create tall Emacs frames without having to
4278 guess how tall the tool-bar will get. */
4279 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
4281 #ifdef USE_X_TOOLKIT
4282 x_window (f
, window_prompting
, minibuffer_only
);
4290 /* Now consider the frame official. */
4291 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
4292 Vframe_list
= Fcons (frame
, Vframe_list
);
4294 /* We need to do this after creating the X window, so that the
4295 icon-creation functions can say whose icon they're describing. */
4296 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4297 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4299 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4300 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4301 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4302 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4303 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4304 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4305 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4306 "scrollBarWidth", "ScrollBarWidth",
4309 /* Dimensions, especially f->height, must be done via change_frame_size.
4310 Change will not be effected unless different from the current
4315 SET_FRAME_WIDTH (f
, 0);
4316 change_frame_size (f
, height
, width
, 1, 0, 0);
4318 /* Set up faces after all frame parameters are known. This call
4319 also merges in face attributes specified for new frames. If we
4320 don't do this, the `menu' face for instance won't have the right
4321 colors, and the menu bar won't appear in the specified colors for
4323 call1 (Qface_set_after_frame_default
, frame
);
4325 #ifdef USE_X_TOOLKIT
4326 /* Create the menu bar. */
4327 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4329 /* If this signals an error, we haven't set size hints for the
4330 frame and we didn't make it visible. */
4331 initialize_frame_menubar (f
);
4333 /* This is a no-op, except under Motif where it arranges the
4334 main window for the widgets on it. */
4335 lw_set_main_areas (f
->output_data
.x
->column_widget
,
4336 f
->output_data
.x
->menubar_widget
,
4337 f
->output_data
.x
->edit_widget
);
4339 #endif /* USE_X_TOOLKIT */
4341 /* Tell the server what size and position, etc, we want, and how
4342 badly we want them. This should be done after we have the menu
4343 bar so that its size can be taken into account. */
4345 x_wm_set_size_hint (f
, window_prompting
, 0);
4348 /* Make the window appear on the frame and enable display, unless
4349 the caller says not to. However, with explicit parent, Emacs
4350 cannot control visibility, so don't try. */
4351 if (! f
->output_data
.x
->explicit_parent
)
4353 Lisp_Object visibility
;
4355 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
4357 if (EQ (visibility
, Qunbound
))
4360 if (EQ (visibility
, Qicon
))
4361 x_iconify_frame (f
);
4362 else if (! NILP (visibility
))
4363 x_make_frame_visible (f
);
4365 /* Must have been Qnil. */
4370 return unbind_to (count
, frame
);
4373 /* FRAME is used only to get a handle on the X display. We don't pass the
4374 display info directly because we're called from frame.c, which doesn't
4375 know about that structure. */
4378 x_get_focus_frame (frame
)
4379 struct frame
*frame
;
4381 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
4383 if (! dpyinfo
->x_focus_frame
)
4386 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
4391 /* In certain situations, when the window manager follows a
4392 click-to-focus policy, there seems to be no way around calling
4393 XSetInputFocus to give another frame the input focus .
4395 In an ideal world, XSetInputFocus should generally be avoided so
4396 that applications don't interfere with the window manager's focus
4397 policy. But I think it's okay to use when it's clearly done
4398 following a user-command. */
4400 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4401 "Set the input focus to FRAME.\n\
4402 FRAME nil means use the selected frame.")
4406 struct frame
*f
= check_x_frame (frame
);
4407 Display
*dpy
= FRAME_X_DISPLAY (f
);
4411 count
= x_catch_errors (dpy
);
4412 XSetInputFocus (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4413 RevertToParent
, CurrentTime
);
4414 x_uncatch_errors (dpy
, count
);
4421 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
4422 "Internal function called by `color-defined-p', which see.")
4424 Lisp_Object color
, frame
;
4427 FRAME_PTR f
= check_x_frame (frame
);
4429 CHECK_STRING (color
, 1);
4431 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4437 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
4438 "Internal function called by `color-values', which see.")
4440 Lisp_Object color
, frame
;
4443 FRAME_PTR f
= check_x_frame (frame
);
4445 CHECK_STRING (color
, 1);
4447 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4451 rgb
[0] = make_number (foo
.red
);
4452 rgb
[1] = make_number (foo
.green
);
4453 rgb
[2] = make_number (foo
.blue
);
4454 return Flist (3, rgb
);
4460 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
4461 "Internal function called by `display-color-p', which see.")
4463 Lisp_Object display
;
4465 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4467 if (dpyinfo
->n_planes
<= 2)
4470 switch (dpyinfo
->visual
->class)
4483 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4485 "Return t if the X display supports shades of gray.\n\
4486 Note that color displays do support shades of gray.\n\
4487 The optional argument DISPLAY specifies which display to ask about.\n\
4488 DISPLAY should be either a frame or a display name (a string).\n\
4489 If omitted or nil, that stands for the selected frame's display.")
4491 Lisp_Object display
;
4493 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4495 if (dpyinfo
->n_planes
<= 1)
4498 switch (dpyinfo
->visual
->class)
4513 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4515 "Returns the width in pixels of the X display DISPLAY.\n\
4516 The optional argument DISPLAY specifies which display to ask about.\n\
4517 DISPLAY should be either a frame or a display name (a string).\n\
4518 If omitted or nil, that stands for the selected frame's display.")
4520 Lisp_Object display
;
4522 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4524 return make_number (dpyinfo
->width
);
4527 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4528 Sx_display_pixel_height
, 0, 1, 0,
4529 "Returns the height in pixels of the X display DISPLAY.\n\
4530 The optional argument DISPLAY specifies which display to ask about.\n\
4531 DISPLAY should be either a frame or a display name (a string).\n\
4532 If omitted or nil, that stands for the selected frame's display.")
4534 Lisp_Object display
;
4536 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4538 return make_number (dpyinfo
->height
);
4541 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4543 "Returns the number of bitplanes of the X display DISPLAY.\n\
4544 The optional argument DISPLAY specifies which display to ask about.\n\
4545 DISPLAY should be either a frame or a display name (a string).\n\
4546 If omitted or nil, that stands for the selected frame's display.")
4548 Lisp_Object display
;
4550 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4552 return make_number (dpyinfo
->n_planes
);
4555 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4557 "Returns the number of color cells of the X display DISPLAY.\n\
4558 The optional argument DISPLAY specifies which display to ask about.\n\
4559 DISPLAY should be either a frame or a display name (a string).\n\
4560 If omitted or nil, that stands for the selected frame's display.")
4562 Lisp_Object display
;
4564 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4566 return make_number (DisplayCells (dpyinfo
->display
,
4567 XScreenNumberOfScreen (dpyinfo
->screen
)));
4570 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4571 Sx_server_max_request_size
,
4573 "Returns the maximum request size of the X server of display DISPLAY.\n\
4574 The optional argument DISPLAY specifies which display to ask about.\n\
4575 DISPLAY should be either a frame or a display name (a string).\n\
4576 If omitted or nil, that stands for the selected frame's display.")
4578 Lisp_Object display
;
4580 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4582 return make_number (MAXREQUEST (dpyinfo
->display
));
4585 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4586 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4587 The optional argument DISPLAY specifies which display to ask about.\n\
4588 DISPLAY should be either a frame or a display name (a string).\n\
4589 If omitted or nil, that stands for the selected frame's display.")
4591 Lisp_Object display
;
4593 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4594 char *vendor
= ServerVendor (dpyinfo
->display
);
4596 if (! vendor
) vendor
= "";
4597 return build_string (vendor
);
4600 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4601 "Returns the version numbers of the X server of display DISPLAY.\n\
4602 The value is a list of three integers: the major and minor\n\
4603 version numbers of the X Protocol in use, and the vendor-specific release\n\
4604 number. See also the function `x-server-vendor'.\n\n\
4605 The optional argument DISPLAY specifies which display to ask about.\n\
4606 DISPLAY should be either a frame or a display name (a string).\n\
4607 If omitted or nil, that stands for the selected frame's display.")
4609 Lisp_Object display
;
4611 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4612 Display
*dpy
= dpyinfo
->display
;
4614 return Fcons (make_number (ProtocolVersion (dpy
)),
4615 Fcons (make_number (ProtocolRevision (dpy
)),
4616 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4619 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4620 "Returns the number of screens on the X server of display DISPLAY.\n\
4621 The optional argument DISPLAY specifies which display to ask about.\n\
4622 DISPLAY should be either a frame or a display name (a string).\n\
4623 If omitted or nil, that stands for the selected frame's display.")
4625 Lisp_Object display
;
4627 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4629 return make_number (ScreenCount (dpyinfo
->display
));
4632 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4633 "Returns the height in millimeters of the X display DISPLAY.\n\
4634 The optional argument DISPLAY specifies which display to ask about.\n\
4635 DISPLAY should be either a frame or a display name (a string).\n\
4636 If omitted or nil, that stands for the selected frame's display.")
4638 Lisp_Object display
;
4640 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4642 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4645 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4646 "Returns the width in millimeters of the X display DISPLAY.\n\
4647 The optional argument DISPLAY specifies which display to ask about.\n\
4648 DISPLAY should be either a frame or a display name (a string).\n\
4649 If omitted or nil, that stands for the selected frame's display.")
4651 Lisp_Object display
;
4653 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4655 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4658 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4659 Sx_display_backing_store
, 0, 1, 0,
4660 "Returns an indication of whether X display DISPLAY does backing store.\n\
4661 The value may be `always', `when-mapped', or `not-useful'.\n\
4662 The optional argument DISPLAY specifies which display to ask about.\n\
4663 DISPLAY should be either a frame or a display name (a string).\n\
4664 If omitted or nil, that stands for the selected frame's display.")
4666 Lisp_Object display
;
4668 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4671 switch (DoesBackingStore (dpyinfo
->screen
))
4674 result
= intern ("always");
4678 result
= intern ("when-mapped");
4682 result
= intern ("not-useful");
4686 error ("Strange value for BackingStore parameter of screen");
4693 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4694 Sx_display_visual_class
, 0, 1, 0,
4695 "Returns the visual class of the X display DISPLAY.\n\
4696 The value is one of the symbols `static-gray', `gray-scale',\n\
4697 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4698 The optional argument DISPLAY specifies which display to ask about.\n\
4699 DISPLAY should be either a frame or a display name (a string).\n\
4700 If omitted or nil, that stands for the selected frame's display.")
4702 Lisp_Object display
;
4704 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4707 switch (dpyinfo
->visual
->class)
4710 result
= intern ("static-gray");
4713 result
= intern ("gray-scale");
4716 result
= intern ("static-color");
4719 result
= intern ("pseudo-color");
4722 result
= intern ("true-color");
4725 result
= intern ("direct-color");
4728 error ("Display has an unknown visual class");
4735 DEFUN ("x-display-save-under", Fx_display_save_under
,
4736 Sx_display_save_under
, 0, 1, 0,
4737 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4738 The optional argument DISPLAY specifies which display to ask about.\n\
4739 DISPLAY should be either a frame or a display name (a string).\n\
4740 If omitted or nil, that stands for the selected frame's display.")
4742 Lisp_Object display
;
4744 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4746 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4754 register struct frame
*f
;
4756 return PIXEL_WIDTH (f
);
4761 register struct frame
*f
;
4763 return PIXEL_HEIGHT (f
);
4768 register struct frame
*f
;
4770 return FONT_WIDTH (f
->output_data
.x
->font
);
4775 register struct frame
*f
;
4777 return f
->output_data
.x
->line_height
;
4782 register struct frame
*f
;
4784 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4789 /************************************************************************
4791 ************************************************************************/
4794 /* Mapping visual names to visuals. */
4796 static struct visual_class
4803 {"StaticGray", StaticGray
},
4804 {"GrayScale", GrayScale
},
4805 {"StaticColor", StaticColor
},
4806 {"PseudoColor", PseudoColor
},
4807 {"TrueColor", TrueColor
},
4808 {"DirectColor", DirectColor
},
4813 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4815 /* Value is the screen number of screen SCR. This is a substitute for
4816 the X function with the same name when that doesn't exist. */
4819 XScreenNumberOfScreen (scr
)
4820 register Screen
*scr
;
4822 Display
*dpy
= scr
->display
;
4825 for (i
= 0; i
< dpy
->nscreens
; ++i
)
4826 if (scr
== dpy
->screens
[i
])
4832 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4835 /* Select the visual that should be used on display DPYINFO. Set
4836 members of DPYINFO appropriately. Called from x_term_init. */
4839 select_visual (dpyinfo
)
4840 struct x_display_info
*dpyinfo
;
4842 Display
*dpy
= dpyinfo
->display
;
4843 Screen
*screen
= dpyinfo
->screen
;
4846 /* See if a visual is specified. */
4847 value
= display_x_get_resource (dpyinfo
,
4848 build_string ("visualClass"),
4849 build_string ("VisualClass"),
4851 if (STRINGP (value
))
4853 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4854 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4855 depth, a decimal number. NAME is compared with case ignored. */
4856 char *s
= (char *) alloca (STRING_BYTES (XSTRING (value
)) + 1);
4861 strcpy (s
, XSTRING (value
)->data
);
4862 dash
= index (s
, '-');
4865 dpyinfo
->n_planes
= atoi (dash
+ 1);
4869 /* We won't find a matching visual with depth 0, so that
4870 an error will be printed below. */
4871 dpyinfo
->n_planes
= 0;
4873 /* Determine the visual class. */
4874 for (i
= 0; visual_classes
[i
].name
; ++i
)
4875 if (xstricmp (s
, visual_classes
[i
].name
) == 0)
4877 class = visual_classes
[i
].class;
4881 /* Look up a matching visual for the specified class. */
4883 || !XMatchVisualInfo (dpy
, XScreenNumberOfScreen (screen
),
4884 dpyinfo
->n_planes
, class, &vinfo
))
4885 fatal ("Invalid visual specification `%s'", XSTRING (value
)->data
);
4887 dpyinfo
->visual
= vinfo
.visual
;
4892 XVisualInfo
*vinfo
, vinfo_template
;
4894 dpyinfo
->visual
= DefaultVisualOfScreen (screen
);
4897 vinfo_template
.visualid
= XVisualIDFromVisual (dpyinfo
->visual
);
4899 vinfo_template
.visualid
= dpyinfo
->visual
->visualid
;
4901 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
4902 vinfo
= XGetVisualInfo (dpy
, VisualIDMask
| VisualScreenMask
,
4903 &vinfo_template
, &n_visuals
);
4905 fatal ("Can't get proper X visual info");
4907 dpyinfo
->n_planes
= vinfo
->depth
;
4908 XFree ((char *) vinfo
);
4913 /* Return the X display structure for the display named NAME.
4914 Open a new connection if necessary. */
4916 struct x_display_info
*
4917 x_display_info_for_name (name
)
4921 struct x_display_info
*dpyinfo
;
4923 CHECK_STRING (name
, 0);
4925 if (! EQ (Vwindow_system
, intern ("x")))
4926 error ("Not using X Windows");
4928 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
4930 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
4933 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
4938 /* Use this general default value to start with. */
4939 Vx_resource_name
= Vinvocation_name
;
4941 validate_x_resource_name ();
4943 dpyinfo
= x_term_init (name
, (unsigned char *)0,
4944 (char *) XSTRING (Vx_resource_name
)->data
);
4947 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
4950 XSETFASTINT (Vwindow_system_version
, 11);
4956 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4957 1, 3, 0, "Open a connection to an X server.\n\
4958 DISPLAY is the name of the display to connect to.\n\
4959 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4960 If the optional third arg MUST-SUCCEED is non-nil,\n\
4961 terminate Emacs if we can't open the connection.")
4962 (display
, xrm_string
, must_succeed
)
4963 Lisp_Object display
, xrm_string
, must_succeed
;
4965 unsigned char *xrm_option
;
4966 struct x_display_info
*dpyinfo
;
4968 CHECK_STRING (display
, 0);
4969 if (! NILP (xrm_string
))
4970 CHECK_STRING (xrm_string
, 1);
4972 if (! EQ (Vwindow_system
, intern ("x")))
4973 error ("Not using X Windows");
4975 if (! NILP (xrm_string
))
4976 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4978 xrm_option
= (unsigned char *) 0;
4980 validate_x_resource_name ();
4982 /* This is what opens the connection and sets x_current_display.
4983 This also initializes many symbols, such as those used for input. */
4984 dpyinfo
= x_term_init (display
, xrm_option
,
4985 (char *) XSTRING (Vx_resource_name
)->data
);
4989 if (!NILP (must_succeed
))
4990 fatal ("Cannot connect to X server %s.\n\
4991 Check the DISPLAY environment variable or use `-d'.\n\
4992 Also use the `xhost' program to verify that it is set to permit\n\
4993 connections from your machine.\n",
4994 XSTRING (display
)->data
);
4996 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5001 XSETFASTINT (Vwindow_system_version
, 11);
5005 DEFUN ("x-close-connection", Fx_close_connection
,
5006 Sx_close_connection
, 1, 1, 0,
5007 "Close the connection to DISPLAY's X server.\n\
5008 For DISPLAY, specify either a frame or a display name (a string).\n\
5009 If DISPLAY is nil, that stands for the selected frame's display.")
5011 Lisp_Object display
;
5013 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5016 if (dpyinfo
->reference_count
> 0)
5017 error ("Display still has frames on it");
5020 /* Free the fonts in the font table. */
5021 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5022 if (dpyinfo
->font_table
[i
].name
)
5024 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
5025 xfree (dpyinfo
->font_table
[i
].full_name
);
5026 xfree (dpyinfo
->font_table
[i
].name
);
5027 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5030 x_destroy_all_bitmaps (dpyinfo
);
5031 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5033 #ifdef USE_X_TOOLKIT
5034 XtCloseDisplay (dpyinfo
->display
);
5036 XCloseDisplay (dpyinfo
->display
);
5039 x_delete_display (dpyinfo
);
5045 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5046 "Return the list of display names that Emacs has connections to.")
5049 Lisp_Object tail
, result
;
5052 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5053 result
= Fcons (XCAR (XCAR (tail
)), result
);
5058 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5059 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5060 If ON is nil, allow buffering of requests.\n\
5061 Turning on synchronization prohibits the Xlib routines from buffering\n\
5062 requests and seriously degrades performance, but makes debugging much\n\
5064 The optional second argument DISPLAY specifies which display to act on.\n\
5065 DISPLAY should be either a frame or a display name (a string).\n\
5066 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5068 Lisp_Object display
, on
;
5070 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5072 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5077 /* Wait for responses to all X commands issued so far for frame F. */
5084 XSync (FRAME_X_DISPLAY (f
), False
);
5089 /***********************************************************************
5091 ***********************************************************************/
5093 /* Value is the number of elements of vector VECTOR. */
5095 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5097 /* List of supported image types. Use define_image_type to add new
5098 types. Use lookup_image_type to find a type for a given symbol. */
5100 static struct image_type
*image_types
;
5102 /* The symbol `image' which is the car of the lists used to represent
5105 extern Lisp_Object Qimage
;
5107 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5113 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5114 extern Lisp_Object QCdata
;
5115 Lisp_Object QCtype
, QCascent
, QCmargin
, QCrelief
;
5116 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5117 Lisp_Object QCindex
, QCmatrix
, QCcolor_adjustment
, QCmask
;
5119 /* Other symbols. */
5121 Lisp_Object Qlaplace
, Qemboss
, Qedge_detection
, Qheuristic
;
5123 /* Time in seconds after which images should be removed from the cache
5124 if not displayed. */
5126 Lisp_Object Vimage_cache_eviction_delay
;
5128 /* Function prototypes. */
5130 static void define_image_type
P_ ((struct image_type
*type
));
5131 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5132 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5133 static void x_laplace
P_ ((struct frame
*, struct image
*));
5134 static void x_emboss
P_ ((struct frame
*, struct image
*));
5135 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5139 /* Define a new image type from TYPE. This adds a copy of TYPE to
5140 image_types and adds the symbol *TYPE->type to Vimage_types. */
5143 define_image_type (type
)
5144 struct image_type
*type
;
5146 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5147 The initialized data segment is read-only. */
5148 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5149 bcopy (type
, p
, sizeof *p
);
5150 p
->next
= image_types
;
5152 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5156 /* Look up image type SYMBOL, and return a pointer to its image_type
5157 structure. Value is null if SYMBOL is not a known image type. */
5159 static INLINE
struct image_type
*
5160 lookup_image_type (symbol
)
5163 struct image_type
*type
;
5165 for (type
= image_types
; type
; type
= type
->next
)
5166 if (EQ (symbol
, *type
->type
))
5173 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5174 valid image specification is a list whose car is the symbol
5175 `image', and whose rest is a property list. The property list must
5176 contain a value for key `:type'. That value must be the name of a
5177 supported image type. The rest of the property list depends on the
5181 valid_image_p (object
)
5186 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5188 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5189 struct image_type
*type
= lookup_image_type (symbol
);
5192 valid_p
= type
->valid_p (object
);
5199 /* Log error message with format string FORMAT and argument ARG.
5200 Signaling an error, e.g. when an image cannot be loaded, is not a
5201 good idea because this would interrupt redisplay, and the error
5202 message display would lead to another redisplay. This function
5203 therefore simply displays a message. */
5206 image_error (format
, arg1
, arg2
)
5208 Lisp_Object arg1
, arg2
;
5210 add_to_log (format
, arg1
, arg2
);
5215 /***********************************************************************
5216 Image specifications
5217 ***********************************************************************/
5219 enum image_value_type
5221 IMAGE_DONT_CHECK_VALUE_TYPE
,
5224 IMAGE_POSITIVE_INTEGER_VALUE
,
5225 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5227 IMAGE_INTEGER_VALUE
,
5228 IMAGE_FUNCTION_VALUE
,
5233 /* Structure used when parsing image specifications. */
5235 struct image_keyword
5237 /* Name of keyword. */
5240 /* The type of value allowed. */
5241 enum image_value_type type
;
5243 /* Non-zero means key must be present. */
5246 /* Used to recognize duplicate keywords in a property list. */
5249 /* The value that was found. */
5254 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5256 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5259 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5260 has the format (image KEYWORD VALUE ...). One of the keyword/
5261 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5262 image_keywords structures of size NKEYWORDS describing other
5263 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5266 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5268 struct image_keyword
*keywords
;
5275 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5278 plist
= XCDR (spec
);
5279 while (CONSP (plist
))
5281 Lisp_Object key
, value
;
5283 /* First element of a pair must be a symbol. */
5285 plist
= XCDR (plist
);
5289 /* There must follow a value. */
5292 value
= XCAR (plist
);
5293 plist
= XCDR (plist
);
5295 /* Find key in KEYWORDS. Error if not found. */
5296 for (i
= 0; i
< nkeywords
; ++i
)
5297 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5303 /* Record that we recognized the keyword. If a keywords
5304 was found more than once, it's an error. */
5305 keywords
[i
].value
= value
;
5306 ++keywords
[i
].count
;
5308 if (keywords
[i
].count
> 1)
5311 /* Check type of value against allowed type. */
5312 switch (keywords
[i
].type
)
5314 case IMAGE_STRING_VALUE
:
5315 if (!STRINGP (value
))
5319 case IMAGE_SYMBOL_VALUE
:
5320 if (!SYMBOLP (value
))
5324 case IMAGE_POSITIVE_INTEGER_VALUE
:
5325 if (!INTEGERP (value
) || XINT (value
) <= 0)
5329 case IMAGE_ASCENT_VALUE
:
5330 if (SYMBOLP (value
) && EQ (value
, Qcenter
))
5332 else if (INTEGERP (value
)
5333 && XINT (value
) >= 0
5334 && XINT (value
) <= 100)
5338 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5339 if (!INTEGERP (value
) || XINT (value
) < 0)
5343 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5346 case IMAGE_FUNCTION_VALUE
:
5347 value
= indirect_function (value
);
5349 || COMPILEDP (value
)
5350 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5354 case IMAGE_NUMBER_VALUE
:
5355 if (!INTEGERP (value
) && !FLOATP (value
))
5359 case IMAGE_INTEGER_VALUE
:
5360 if (!INTEGERP (value
))
5364 case IMAGE_BOOL_VALUE
:
5365 if (!NILP (value
) && !EQ (value
, Qt
))
5374 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5378 /* Check that all mandatory fields are present. */
5379 for (i
= 0; i
< nkeywords
; ++i
)
5380 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5383 return NILP (plist
);
5387 /* Return the value of KEY in image specification SPEC. Value is nil
5388 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5389 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5392 image_spec_value (spec
, key
, found
)
5393 Lisp_Object spec
, key
;
5398 xassert (valid_image_p (spec
));
5400 for (tail
= XCDR (spec
);
5401 CONSP (tail
) && CONSP (XCDR (tail
));
5402 tail
= XCDR (XCDR (tail
)))
5404 if (EQ (XCAR (tail
), key
))
5408 return XCAR (XCDR (tail
));
5418 DEFUN ("image-size", Fimage_size
, Simage_size
, 1, 3, 0,
5419 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5420 PIXELS non-nil means return the size in pixels, otherwise return the\n\
5421 size in canonical character units.\n\
5422 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5423 or omitted means use the selected frame.")
5424 (spec
, pixels
, frame
)
5425 Lisp_Object spec
, pixels
, frame
;
5430 if (valid_image_p (spec
))
5432 struct frame
*f
= check_x_frame (frame
);
5433 int id
= lookup_image (f
, spec
);
5434 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5435 int width
= img
->width
+ 2 * img
->margin
;
5436 int height
= img
->height
+ 2 * img
->margin
;
5439 size
= Fcons (make_float ((double) width
/ CANON_X_UNIT (f
)),
5440 make_float ((double) height
/ CANON_Y_UNIT (f
)));
5442 size
= Fcons (make_number (width
), make_number (height
));
5445 error ("Invalid image specification");
5451 DEFUN ("image-mask-p", Fimage_mask_p
, Simage_mask_p
, 1, 2, 0,
5452 "Return t if image SPEC has a mask bitmap.\n\
5453 FRAME is the frame on which the image will be displayed. FRAME nil\n\
5454 or omitted means use the selected frame.")
5456 Lisp_Object spec
, frame
;
5461 if (valid_image_p (spec
))
5463 struct frame
*f
= check_x_frame (frame
);
5464 int id
= lookup_image (f
, spec
);
5465 struct image
*img
= IMAGE_FROM_ID (f
, id
);
5470 error ("Invalid image specification");
5477 /***********************************************************************
5478 Image type independent image structures
5479 ***********************************************************************/
5481 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5482 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5485 /* Allocate and return a new image structure for image specification
5486 SPEC. SPEC has a hash value of HASH. */
5488 static struct image
*
5489 make_image (spec
, hash
)
5493 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5495 xassert (valid_image_p (spec
));
5496 bzero (img
, sizeof *img
);
5497 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5498 xassert (img
->type
!= NULL
);
5500 img
->data
.lisp_val
= Qnil
;
5501 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5507 /* Free image IMG which was used on frame F, including its resources. */
5516 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5518 /* Remove IMG from the hash table of its cache. */
5520 img
->prev
->next
= img
->next
;
5522 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5525 img
->next
->prev
= img
->prev
;
5527 c
->images
[img
->id
] = NULL
;
5529 /* Free resources, then free IMG. */
5530 img
->type
->free (f
, img
);
5536 /* Prepare image IMG for display on frame F. Must be called before
5537 drawing an image. */
5540 prepare_image_for_display (f
, img
)
5546 /* We're about to display IMG, so set its timestamp to `now'. */
5548 img
->timestamp
= EMACS_SECS (t
);
5550 /* If IMG doesn't have a pixmap yet, load it now, using the image
5551 type dependent loader function. */
5552 if (img
->pixmap
== None
&& !img
->load_failed_p
)
5553 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5557 /* Value is the number of pixels for the ascent of image IMG when
5558 drawn in face FACE. */
5561 image_ascent (img
, face
)
5565 int height
= img
->height
+ img
->margin
;
5568 if (img
->ascent
== CENTERED_IMAGE_ASCENT
)
5571 /* This expression is arranged so that if the image can't be
5572 exactly centered, it will be moved slightly up. This is
5573 because a typical font is `top-heavy' (due to the presence
5574 uppercase letters), so the image placement should err towards
5575 being top-heavy too. It also just generally looks better. */
5576 ascent
= (height
+ face
->font
->ascent
- face
->font
->descent
+ 1) / 2;
5578 ascent
= height
/ 2;
5581 ascent
= height
* img
->ascent
/ 100.0;
5588 /***********************************************************************
5589 Helper functions for X image types
5590 ***********************************************************************/
5592 static void x_clear_image_1
P_ ((struct frame
*, struct image
*, int,
5594 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5595 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5597 Lisp_Object color_name
,
5598 unsigned long dflt
));
5601 /* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5602 free the pixmap if any. MASK_P non-zero means clear the mask
5603 pixmap if any. COLORS_P non-zero means free colors allocated for
5604 the image, if any. */
5607 x_clear_image_1 (f
, img
, pixmap_p
, mask_p
, colors_p
)
5610 int pixmap_p
, mask_p
, colors_p
;
5612 if (pixmap_p
&& img
->pixmap
)
5614 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5618 if (mask_p
&& img
->mask
)
5620 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5624 if (colors_p
&& img
->ncolors
)
5626 x_free_colors (f
, img
->colors
, img
->ncolors
);
5627 xfree (img
->colors
);
5633 /* Free X resources of image IMG which is used on frame F. */
5636 x_clear_image (f
, img
)
5641 x_clear_image_1 (f
, img
, 1, 1, 1);
5646 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5647 cannot be allocated, use DFLT. Add a newly allocated color to
5648 IMG->colors, so that it can be freed again. Value is the pixel
5651 static unsigned long
5652 x_alloc_image_color (f
, img
, color_name
, dflt
)
5655 Lisp_Object color_name
;
5659 unsigned long result
;
5661 xassert (STRINGP (color_name
));
5663 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5665 /* This isn't called frequently so we get away with simply
5666 reallocating the color vector to the needed size, here. */
5669 (unsigned long *) xrealloc (img
->colors
,
5670 img
->ncolors
* sizeof *img
->colors
);
5671 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5672 result
= color
.pixel
;
5682 /***********************************************************************
5684 ***********************************************************************/
5686 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5689 /* Return a new, initialized image cache that is allocated from the
5690 heap. Call free_image_cache to free an image cache. */
5692 struct image_cache
*
5695 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5698 bzero (c
, sizeof *c
);
5700 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5701 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5702 c
->buckets
= (struct image
**) xmalloc (size
);
5703 bzero (c
->buckets
, size
);
5708 /* Free image cache of frame F. Be aware that X frames share images
5712 free_image_cache (f
)
5715 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5720 /* Cache should not be referenced by any frame when freed. */
5721 xassert (c
->refcount
== 0);
5723 for (i
= 0; i
< c
->used
; ++i
)
5724 free_image (f
, c
->images
[i
]);
5728 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5733 /* Clear image cache of frame F. FORCE_P non-zero means free all
5734 images. FORCE_P zero means clear only images that haven't been
5735 displayed for some time. Should be called from time to time to
5736 reduce the number of loaded images. If image-eviction-seconds is
5737 non-nil, this frees images in the cache which weren't displayed for
5738 at least that many seconds. */
5741 clear_image_cache (f
, force_p
)
5745 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5747 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5754 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5756 /* Block input so that we won't be interrupted by a SIGIO
5757 while being in an inconsistent state. */
5760 for (i
= nfreed
= 0; i
< c
->used
; ++i
)
5762 struct image
*img
= c
->images
[i
];
5764 && (force_p
|| img
->timestamp
< old
))
5766 free_image (f
, img
);
5771 /* We may be clearing the image cache because, for example,
5772 Emacs was iconified for a longer period of time. In that
5773 case, current matrices may still contain references to
5774 images freed above. So, clear these matrices. */
5777 Lisp_Object tail
, frame
;
5779 FOR_EACH_FRAME (tail
, frame
)
5781 struct frame
*f
= XFRAME (frame
);
5783 && FRAME_X_IMAGE_CACHE (f
) == c
)
5784 clear_current_matrices (f
);
5787 ++windows_or_buffers_changed
;
5795 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5797 "Clear the image cache of FRAME.\n\
5798 FRAME nil or omitted means use the selected frame.\n\
5799 FRAME t means clear the image caches of all frames.")
5807 FOR_EACH_FRAME (tail
, frame
)
5808 if (FRAME_X_P (XFRAME (frame
)))
5809 clear_image_cache (XFRAME (frame
), 1);
5812 clear_image_cache (check_x_frame (frame
), 1);
5818 /* Return the id of image with Lisp specification SPEC on frame F.
5819 SPEC must be a valid Lisp image specification (see valid_image_p). */
5822 lookup_image (f
, spec
)
5826 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5830 struct gcpro gcpro1
;
5833 /* F must be a window-system frame, and SPEC must be a valid image
5835 xassert (FRAME_WINDOW_P (f
));
5836 xassert (valid_image_p (spec
));
5840 /* Look up SPEC in the hash table of the image cache. */
5841 hash
= sxhash (spec
, 0);
5842 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
5844 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
5845 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
5848 /* If not found, create a new image and cache it. */
5852 img
= make_image (spec
, hash
);
5853 cache_image (f
, img
);
5854 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5856 /* If we can't load the image, and we don't have a width and
5857 height, use some arbitrary width and height so that we can
5858 draw a rectangle for it. */
5859 if (img
->load_failed_p
)
5863 value
= image_spec_value (spec
, QCwidth
, NULL
);
5864 img
->width
= (INTEGERP (value
)
5865 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
5866 value
= image_spec_value (spec
, QCheight
, NULL
);
5867 img
->height
= (INTEGERP (value
)
5868 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
5872 /* Handle image type independent image attributes
5873 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
5874 Lisp_Object ascent
, margin
, relief
;
5877 ascent
= image_spec_value (spec
, QCascent
, NULL
);
5878 if (INTEGERP (ascent
))
5879 img
->ascent
= XFASTINT (ascent
);
5880 else if (EQ (ascent
, Qcenter
))
5881 img
->ascent
= CENTERED_IMAGE_ASCENT
;
5883 margin
= image_spec_value (spec
, QCmargin
, NULL
);
5884 if (INTEGERP (margin
) && XINT (margin
) >= 0)
5885 img
->margin
= XFASTINT (margin
);
5887 relief
= image_spec_value (spec
, QCrelief
, NULL
);
5888 if (INTEGERP (relief
))
5890 img
->relief
= XINT (relief
);
5891 img
->margin
+= abs (img
->relief
);
5894 /* Manipulation of the image's mask. */
5897 /* `:heuristic-mask t'
5899 means build a mask heuristically.
5900 `:heuristic-mask (R G B)'
5901 `:mask (heuristic (R G B))'
5902 means build a mask from color (R G B) in the
5905 means remove a mask, if any. */
5909 mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
5911 x_build_heuristic_mask (f
, img
, mask
);
5916 mask
= image_spec_value (spec
, QCmask
, &found_p
);
5918 if (EQ (mask
, Qheuristic
))
5919 x_build_heuristic_mask (f
, img
, Qt
);
5920 else if (CONSP (mask
)
5921 && EQ (XCAR (mask
), Qheuristic
))
5923 if (CONSP (XCDR (mask
)))
5924 x_build_heuristic_mask (f
, img
, XCAR (XCDR (mask
)));
5926 x_build_heuristic_mask (f
, img
, XCDR (mask
));
5928 else if (NILP (mask
) && found_p
&& img
->mask
)
5930 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
5936 /* Should we apply an image transformation algorithm? */
5939 Lisp_Object algorithm
;
5941 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
5942 if (EQ (algorithm
, Qdisabled
))
5943 x_disable_image (f
, img
);
5944 else if (EQ (algorithm
, Qlaplace
))
5946 else if (EQ (algorithm
, Qemboss
))
5948 else if (CONSP (algorithm
)
5949 && EQ (XCAR (algorithm
), Qedge_detection
))
5952 tem
= XCDR (algorithm
);
5954 x_edge_detection (f
, img
,
5955 Fplist_get (tem
, QCmatrix
),
5956 Fplist_get (tem
, QCcolor_adjustment
));
5962 xassert (!interrupt_input_blocked
);
5965 /* We're using IMG, so set its timestamp to `now'. */
5966 EMACS_GET_TIME (now
);
5967 img
->timestamp
= EMACS_SECS (now
);
5971 /* Value is the image id. */
5976 /* Cache image IMG in the image cache of frame F. */
5979 cache_image (f
, img
)
5983 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5986 /* Find a free slot in c->images. */
5987 for (i
= 0; i
< c
->used
; ++i
)
5988 if (c
->images
[i
] == NULL
)
5991 /* If no free slot found, maybe enlarge c->images. */
5992 if (i
== c
->used
&& c
->used
== c
->size
)
5995 c
->images
= (struct image
**) xrealloc (c
->images
,
5996 c
->size
* sizeof *c
->images
);
5999 /* Add IMG to c->images, and assign IMG an id. */
6005 /* Add IMG to the cache's hash table. */
6006 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6007 img
->next
= c
->buckets
[i
];
6009 img
->next
->prev
= img
;
6011 c
->buckets
[i
] = img
;
6015 /* Call FN on every image in the image cache of frame F. Used to mark
6016 Lisp Objects in the image cache. */
6019 forall_images_in_image_cache (f
, fn
)
6021 void (*fn
) P_ ((struct image
*img
));
6023 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6025 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6029 for (i
= 0; i
< c
->used
; ++i
)
6038 /***********************************************************************
6040 ***********************************************************************/
6042 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6043 XImage
**, Pixmap
*));
6044 static void x_destroy_x_image
P_ ((XImage
*));
6045 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6048 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6049 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6050 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6051 via xmalloc. Print error messages via image_error if an error
6052 occurs. Value is non-zero if successful. */
6055 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6057 int width
, height
, depth
;
6061 Display
*display
= FRAME_X_DISPLAY (f
);
6062 Screen
*screen
= FRAME_X_SCREEN (f
);
6063 Window window
= FRAME_X_WINDOW (f
);
6065 xassert (interrupt_input_blocked
);
6068 depth
= DefaultDepthOfScreen (screen
);
6069 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6070 depth
, ZPixmap
, 0, NULL
, width
, height
,
6071 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6074 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6078 /* Allocate image raster. */
6079 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6081 /* Allocate a pixmap of the same size. */
6082 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6083 if (*pixmap
== None
)
6085 x_destroy_x_image (*ximg
);
6087 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6095 /* Destroy XImage XIMG. Free XIMG->data. */
6098 x_destroy_x_image (ximg
)
6101 xassert (interrupt_input_blocked
);
6106 XDestroyImage (ximg
);
6111 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6112 are width and height of both the image and pixmap. */
6115 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6122 xassert (interrupt_input_blocked
);
6123 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6124 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6125 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6130 /***********************************************************************
6132 ***********************************************************************/
6134 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6135 static char *slurp_file
P_ ((char *, int *));
6138 /* Find image file FILE. Look in data-directory, then
6139 x-bitmap-file-path. Value is the full name of the file found, or
6140 nil if not found. */
6143 x_find_image_file (file
)
6146 Lisp_Object file_found
, search_path
;
6147 struct gcpro gcpro1
, gcpro2
;
6151 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6152 GCPRO2 (file_found
, search_path
);
6154 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6155 fd
= openp (search_path
, file
, "", &file_found
, 0);
6167 /* Read FILE into memory. Value is a pointer to a buffer allocated
6168 with xmalloc holding FILE's contents. Value is null if an error
6169 occurred. *SIZE is set to the size of the file. */
6172 slurp_file (file
, size
)
6180 if (stat (file
, &st
) == 0
6181 && (fp
= fopen (file
, "r")) != NULL
6182 && (buf
= (char *) xmalloc (st
.st_size
),
6183 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
6204 /***********************************************************************
6206 ***********************************************************************/
6208 static int xbm_scan
P_ ((char **, char *, char *, int *));
6209 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6210 static int xbm_load_image
P_ ((struct frame
*f
, struct image
*img
,
6212 static int xbm_image_p
P_ ((Lisp_Object object
));
6213 static int xbm_read_bitmap_data
P_ ((char *, char *, int *, int *,
6215 static int xbm_file_p
P_ ((Lisp_Object
));
6218 /* Indices of image specification fields in xbm_format, below. */
6220 enum xbm_keyword_index
6238 /* Vector of image_keyword structures describing the format
6239 of valid XBM image specifications. */
6241 static struct image_keyword xbm_format
[XBM_LAST
] =
6243 {":type", IMAGE_SYMBOL_VALUE
, 1},
6244 {":file", IMAGE_STRING_VALUE
, 0},
6245 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6246 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6247 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6248 {":foreground", IMAGE_STRING_VALUE
, 0},
6249 {":background", IMAGE_STRING_VALUE
, 0},
6250 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6251 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6252 {":relief", IMAGE_INTEGER_VALUE
, 0},
6253 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6254 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6255 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6258 /* Structure describing the image type XBM. */
6260 static struct image_type xbm_type
=
6269 /* Tokens returned from xbm_scan. */
6278 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6279 A valid specification is a list starting with the symbol `image'
6280 The rest of the list is a property list which must contain an
6283 If the specification specifies a file to load, it must contain
6284 an entry `:file FILENAME' where FILENAME is a string.
6286 If the specification is for a bitmap loaded from memory it must
6287 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6288 WIDTH and HEIGHT are integers > 0. DATA may be:
6290 1. a string large enough to hold the bitmap data, i.e. it must
6291 have a size >= (WIDTH + 7) / 8 * HEIGHT
6293 2. a bool-vector of size >= WIDTH * HEIGHT
6295 3. a vector of strings or bool-vectors, one for each line of the
6298 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6299 may not be specified in this case because they are defined in the
6302 Both the file and data forms may contain the additional entries
6303 `:background COLOR' and `:foreground COLOR'. If not present,
6304 foreground and background of the frame on which the image is
6305 displayed is used. */
6308 xbm_image_p (object
)
6311 struct image_keyword kw
[XBM_LAST
];
6313 bcopy (xbm_format
, kw
, sizeof kw
);
6314 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6317 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6319 if (kw
[XBM_FILE
].count
)
6321 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6324 else if (kw
[XBM_DATA
].count
&& xbm_file_p (kw
[XBM_DATA
].value
))
6326 /* In-memory XBM file. */
6327 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_FILE
].count
)
6335 /* Entries for `:width', `:height' and `:data' must be present. */
6336 if (!kw
[XBM_WIDTH
].count
6337 || !kw
[XBM_HEIGHT
].count
6338 || !kw
[XBM_DATA
].count
)
6341 data
= kw
[XBM_DATA
].value
;
6342 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6343 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6345 /* Check type of data, and width and height against contents of
6351 /* Number of elements of the vector must be >= height. */
6352 if (XVECTOR (data
)->size
< height
)
6355 /* Each string or bool-vector in data must be large enough
6356 for one line of the image. */
6357 for (i
= 0; i
< height
; ++i
)
6359 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6363 if (XSTRING (elt
)->size
6364 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6367 else if (BOOL_VECTOR_P (elt
))
6369 if (XBOOL_VECTOR (elt
)->size
< width
)
6376 else if (STRINGP (data
))
6378 if (XSTRING (data
)->size
6379 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6382 else if (BOOL_VECTOR_P (data
))
6384 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6395 /* Scan a bitmap file. FP is the stream to read from. Value is
6396 either an enumerator from enum xbm_token, or a character for a
6397 single-character token, or 0 at end of file. If scanning an
6398 identifier, store the lexeme of the identifier in SVAL. If
6399 scanning a number, store its value in *IVAL. */
6402 xbm_scan (s
, end
, sval
, ival
)
6411 /* Skip white space. */
6412 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
6417 else if (isdigit (c
))
6419 int value
= 0, digit
;
6421 if (c
== '0' && *s
< end
)
6424 if (c
== 'x' || c
== 'X')
6431 else if (c
>= 'a' && c
<= 'f')
6432 digit
= c
- 'a' + 10;
6433 else if (c
>= 'A' && c
<= 'F')
6434 digit
= c
- 'A' + 10;
6437 value
= 16 * value
+ digit
;
6440 else if (isdigit (c
))
6444 && (c
= *(*s
)++, isdigit (c
)))
6445 value
= 8 * value
+ c
- '0';
6452 && (c
= *(*s
)++, isdigit (c
)))
6453 value
= 10 * value
+ c
- '0';
6461 else if (isalpha (c
) || c
== '_')
6465 && (c
= *(*s
)++, (isalnum (c
) || c
== '_')))
6472 else if (c
== '/' && **s
== '*')
6474 /* C-style comment. */
6476 while (**s
&& (**s
!= '*' || *(*s
+ 1) != '/'))
6489 /* Replacement for XReadBitmapFileData which isn't available under old
6490 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6491 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6492 the image. Return in *DATA the bitmap data allocated with xmalloc.
6493 Value is non-zero if successful. DATA null means just test if
6494 CONTENTS looks like an in-memory XBM file. */
6497 xbm_read_bitmap_data (contents
, end
, width
, height
, data
)
6498 char *contents
, *end
;
6499 int *width
, *height
;
6500 unsigned char **data
;
6503 char buffer
[BUFSIZ
];
6506 int bytes_per_line
, i
, nbytes
;
6512 LA1 = xbm_scan (&s, end, buffer, &value)
6514 #define expect(TOKEN) \
6515 if (LA1 != (TOKEN)) \
6520 #define expect_ident(IDENT) \
6521 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6526 *width
= *height
= -1;
6529 LA1
= xbm_scan (&s
, end
, buffer
, &value
);
6531 /* Parse defines for width, height and hot-spots. */
6535 expect_ident ("define");
6536 expect (XBM_TK_IDENT
);
6538 if (LA1
== XBM_TK_NUMBER
);
6540 char *p
= strrchr (buffer
, '_');
6541 p
= p
? p
+ 1 : buffer
;
6542 if (strcmp (p
, "width") == 0)
6544 else if (strcmp (p
, "height") == 0)
6547 expect (XBM_TK_NUMBER
);
6550 if (*width
< 0 || *height
< 0)
6552 else if (data
== NULL
)
6555 /* Parse bits. Must start with `static'. */
6556 expect_ident ("static");
6557 if (LA1
== XBM_TK_IDENT
)
6559 if (strcmp (buffer
, "unsigned") == 0)
6562 expect_ident ("char");
6564 else if (strcmp (buffer
, "short") == 0)
6568 if (*width
% 16 && *width
% 16 < 9)
6571 else if (strcmp (buffer
, "char") == 0)
6579 expect (XBM_TK_IDENT
);
6585 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6586 nbytes
= bytes_per_line
* *height
;
6587 p
= *data
= (char *) xmalloc (nbytes
);
6591 for (i
= 0; i
< nbytes
; i
+= 2)
6594 expect (XBM_TK_NUMBER
);
6597 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6600 if (LA1
== ',' || LA1
== '}')
6608 for (i
= 0; i
< nbytes
; ++i
)
6611 expect (XBM_TK_NUMBER
);
6615 if (LA1
== ',' || LA1
== '}')
6640 /* Load XBM image IMG which will be displayed on frame F from buffer
6641 CONTENTS. END is the end of the buffer. Value is non-zero if
6645 xbm_load_image (f
, img
, contents
, end
)
6648 char *contents
, *end
;
6651 unsigned char *data
;
6654 rc
= xbm_read_bitmap_data (contents
, end
, &img
->width
, &img
->height
, &data
);
6657 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6658 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6659 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6662 xassert (img
->width
> 0 && img
->height
> 0);
6664 /* Get foreground and background colors, maybe allocate colors. */
6665 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6667 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6669 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6671 background
= x_alloc_image_color (f
, img
, value
, background
);
6674 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6677 img
->width
, img
->height
,
6678 foreground
, background
,
6682 if (img
->pixmap
== None
)
6684 x_clear_image (f
, img
);
6685 image_error ("Unable to create X pixmap for `%s'", img
->spec
, Qnil
);
6691 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6697 /* Value is non-zero if DATA looks like an in-memory XBM file. */
6704 return (STRINGP (data
)
6705 && xbm_read_bitmap_data (XSTRING (data
)->data
,
6706 (XSTRING (data
)->data
6707 + STRING_BYTES (XSTRING (data
))),
6712 /* Fill image IMG which is used on frame F with pixmap data. Value is
6713 non-zero if successful. */
6721 Lisp_Object file_name
;
6723 xassert (xbm_image_p (img
->spec
));
6725 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6726 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6727 if (STRINGP (file_name
))
6732 struct gcpro gcpro1
;
6734 file
= x_find_image_file (file_name
);
6736 if (!STRINGP (file
))
6738 image_error ("Cannot find image file `%s'", file_name
, Qnil
);
6743 contents
= slurp_file (XSTRING (file
)->data
, &size
);
6744 if (contents
== NULL
)
6746 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6751 success_p
= xbm_load_image (f
, img
, contents
, contents
+ size
);
6756 struct image_keyword fmt
[XBM_LAST
];
6758 unsigned char *bitmap_data
;
6760 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6761 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6763 int parsed_p
, height
, width
;
6764 int in_memory_file_p
= 0;
6766 /* See if data looks like an in-memory XBM file. */
6767 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
6768 in_memory_file_p
= xbm_file_p (data
);
6770 /* Parse the image specification. */
6771 bcopy (xbm_format
, fmt
, sizeof fmt
);
6772 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6775 /* Get specified width, and height. */
6776 if (!in_memory_file_p
)
6778 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6779 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6780 xassert (img
->width
> 0 && img
->height
> 0);
6783 /* Get foreground and background colors, maybe allocate colors. */
6784 if (fmt
[XBM_FOREGROUND
].count
)
6785 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6787 if (fmt
[XBM_BACKGROUND
].count
)
6788 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6791 if (in_memory_file_p
)
6792 success_p
= xbm_load_image (f
, img
, XSTRING (data
)->data
,
6793 (XSTRING (data
)->data
6794 + STRING_BYTES (XSTRING (data
))));
6801 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6803 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6804 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6806 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6808 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6810 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6813 else if (STRINGP (data
))
6814 bits
= XSTRING (data
)->data
;
6816 bits
= XBOOL_VECTOR (data
)->data
;
6818 /* Create the pixmap. */
6819 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6821 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6824 img
->width
, img
->height
,
6825 foreground
, background
,
6831 image_error ("Unable to create pixmap for XBM image `%s'",
6833 x_clear_image (f
, img
);
6843 /***********************************************************************
6845 ***********************************************************************/
6849 static int xpm_image_p
P_ ((Lisp_Object object
));
6850 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6851 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6853 #include "X11/xpm.h"
6855 /* The symbol `xpm' identifying XPM-format images. */
6859 /* Indices of image specification fields in xpm_format, below. */
6861 enum xpm_keyword_index
6876 /* Vector of image_keyword structures describing the format
6877 of valid XPM image specifications. */
6879 static struct image_keyword xpm_format
[XPM_LAST
] =
6881 {":type", IMAGE_SYMBOL_VALUE
, 1},
6882 {":file", IMAGE_STRING_VALUE
, 0},
6883 {":data", IMAGE_STRING_VALUE
, 0},
6884 {":ascent", IMAGE_ASCENT_VALUE
, 0},
6885 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6886 {":relief", IMAGE_INTEGER_VALUE
, 0},
6887 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6888 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6889 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6890 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6893 /* Structure describing the image type XBM. */
6895 static struct image_type xpm_type
=
6905 /* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
6906 functions for allocating image colors. Our own functions handle
6907 color allocation failures more gracefully than the ones on the XPM
6910 #if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
6911 #define ALLOC_XPM_COLORS
6914 #ifdef ALLOC_XPM_COLORS
6916 static void xpm_init_color_cache
P_ ((struct frame
*, XpmAttributes
*));
6917 static void xpm_free_color_cache
P_ ((void));
6918 static int xpm_lookup_color
P_ ((struct frame
*, char *, XColor
*));
6919 static int xpm_color_bucket
P_ ((char *));
6920 static struct xpm_cached_color
*xpm_cache_color
P_ ((struct frame
*, char *,
6923 /* An entry in a hash table used to cache color definitions of named
6924 colors. This cache is necessary to speed up XPM image loading in
6925 case we do color allocations ourselves. Without it, we would need
6926 a call to XParseColor per pixel in the image. */
6928 struct xpm_cached_color
6930 /* Next in collision chain. */
6931 struct xpm_cached_color
*next
;
6933 /* Color definition (RGB and pixel color). */
6940 /* The hash table used for the color cache, and its bucket vector
6943 #define XPM_COLOR_CACHE_BUCKETS 1001
6944 struct xpm_cached_color
**xpm_color_cache
;
6946 /* Initialize the color cache. */
6949 xpm_init_color_cache (f
, attrs
)
6951 XpmAttributes
*attrs
;
6953 size_t nbytes
= XPM_COLOR_CACHE_BUCKETS
* sizeof *xpm_color_cache
;
6954 xpm_color_cache
= (struct xpm_cached_color
**) xmalloc (nbytes
);
6955 memset (xpm_color_cache
, 0, nbytes
);
6956 init_color_table ();
6958 if (attrs
->valuemask
& XpmColorSymbols
)
6963 for (i
= 0; i
< attrs
->numsymbols
; ++i
)
6964 if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
6965 attrs
->colorsymbols
[i
].value
, &color
))
6967 color
.pixel
= lookup_rgb_color (f
, color
.red
, color
.green
,
6969 xpm_cache_color (f
, attrs
->colorsymbols
[i
].name
, &color
, -1);
6975 /* Free the color cache. */
6978 xpm_free_color_cache ()
6980 struct xpm_cached_color
*p
, *next
;
6983 for (i
= 0; i
< XPM_COLOR_CACHE_BUCKETS
; ++i
)
6984 for (p
= xpm_color_cache
[i
]; p
; p
= next
)
6990 xfree (xpm_color_cache
);
6991 xpm_color_cache
= NULL
;
6992 free_color_table ();
6996 /* Return the bucket index for color named COLOR_NAME in the color
7000 xpm_color_bucket (color_name
)
7006 for (s
= color_name
; *s
; ++s
)
7008 return h
%= XPM_COLOR_CACHE_BUCKETS
;
7012 /* On frame F, cache values COLOR for color with name COLOR_NAME.
7013 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7016 static struct xpm_cached_color
*
7017 xpm_cache_color (f
, color_name
, color
, bucket
)
7024 struct xpm_cached_color
*p
;
7027 bucket
= xpm_color_bucket (color_name
);
7029 nbytes
= sizeof *p
+ strlen (color_name
);
7030 p
= (struct xpm_cached_color
*) xmalloc (nbytes
);
7031 strcpy (p
->name
, color_name
);
7033 p
->next
= xpm_color_cache
[bucket
];
7034 xpm_color_cache
[bucket
] = p
;
7039 /* Look up color COLOR_NAME for frame F in the color cache. If found,
7040 return the cached definition in *COLOR. Otherwise, make a new
7041 entry in the cache and allocate the color. Value is zero if color
7042 allocation failed. */
7045 xpm_lookup_color (f
, color_name
, color
)
7050 struct xpm_cached_color
*p
;
7051 int h
= xpm_color_bucket (color_name
);
7053 for (p
= xpm_color_cache
[h
]; p
; p
= p
->next
)
7054 if (strcmp (p
->name
, color_name
) == 0)
7059 else if (XParseColor (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
7062 color
->pixel
= lookup_rgb_color (f
, color
->red
, color
->green
,
7064 p
= xpm_cache_color (f
, color_name
, color
, h
);
7071 /* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7072 CLOSURE is a pointer to the frame on which we allocate the
7073 color. Return in *COLOR the allocated color. Value is non-zero
7077 xpm_alloc_color (dpy
, cmap
, color_name
, color
, closure
)
7084 return xpm_lookup_color ((struct frame
*) closure
, color_name
, color
);
7088 /* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7089 is a pointer to the frame on which we allocate the color. Value is
7090 non-zero if successful. */
7093 xpm_free_colors (dpy
, cmap
, pixels
, npixels
, closure
)
7103 #endif /* ALLOC_XPM_COLORS */
7106 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7107 for XPM images. Such a list must consist of conses whose car and
7111 xpm_valid_color_symbols_p (color_symbols
)
7112 Lisp_Object color_symbols
;
7114 while (CONSP (color_symbols
))
7116 Lisp_Object sym
= XCAR (color_symbols
);
7118 || !STRINGP (XCAR (sym
))
7119 || !STRINGP (XCDR (sym
)))
7121 color_symbols
= XCDR (color_symbols
);
7124 return NILP (color_symbols
);
7128 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7131 xpm_image_p (object
)
7134 struct image_keyword fmt
[XPM_LAST
];
7135 bcopy (xpm_format
, fmt
, sizeof fmt
);
7136 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
7137 /* Either `:file' or `:data' must be present. */
7138 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7139 /* Either no `:color-symbols' or it's a list of conses
7140 whose car and cdr are strings. */
7141 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7142 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
)));
7146 /* Load image IMG which will be displayed on frame F. Value is
7147 non-zero if successful. */
7155 XpmAttributes attrs
;
7156 Lisp_Object specified_file
, color_symbols
;
7158 /* Configure the XPM lib. Use the visual of frame F. Allocate
7159 close colors. Return colors allocated. */
7160 bzero (&attrs
, sizeof attrs
);
7161 attrs
.visual
= FRAME_X_VISUAL (f
);
7162 attrs
.colormap
= FRAME_X_COLORMAP (f
);
7163 attrs
.valuemask
|= XpmVisual
;
7164 attrs
.valuemask
|= XpmColormap
;
7166 #ifdef ALLOC_XPM_COLORS
7167 /* Allocate colors with our own functions which handle
7168 failing color allocation more gracefully. */
7169 attrs
.color_closure
= f
;
7170 attrs
.alloc_color
= xpm_alloc_color
;
7171 attrs
.free_colors
= xpm_free_colors
;
7172 attrs
.valuemask
|= XpmAllocColor
| XpmFreeColors
| XpmColorClosure
;
7173 #else /* not ALLOC_XPM_COLORS */
7174 /* Let the XPM lib allocate colors. */
7175 attrs
.valuemask
|= XpmReturnAllocPixels
;
7176 #ifdef XpmAllocCloseColors
7177 attrs
.alloc_close_colors
= 1;
7178 attrs
.valuemask
|= XpmAllocCloseColors
;
7179 #else /* not XpmAllocCloseColors */
7180 attrs
.closeness
= 600;
7181 attrs
.valuemask
|= XpmCloseness
;
7182 #endif /* not XpmAllocCloseColors */
7183 #endif /* ALLOC_XPM_COLORS */
7185 /* If image specification contains symbolic color definitions, add
7186 these to `attrs'. */
7187 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7188 if (CONSP (color_symbols
))
7191 XpmColorSymbol
*xpm_syms
;
7194 attrs
.valuemask
|= XpmColorSymbols
;
7196 /* Count number of symbols. */
7197 attrs
.numsymbols
= 0;
7198 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7201 /* Allocate an XpmColorSymbol array. */
7202 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7203 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7204 bzero (xpm_syms
, size
);
7205 attrs
.colorsymbols
= xpm_syms
;
7207 /* Fill the color symbol array. */
7208 for (tail
= color_symbols
, i
= 0;
7210 ++i
, tail
= XCDR (tail
))
7212 Lisp_Object name
= XCAR (XCAR (tail
));
7213 Lisp_Object color
= XCDR (XCAR (tail
));
7214 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7215 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7216 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7217 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7221 /* Create a pixmap for the image, either from a file, or from a
7222 string buffer containing data in the same format as an XPM file. */
7223 #ifdef ALLOC_XPM_COLORS
7224 xpm_init_color_cache (f
, &attrs
);
7227 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7228 if (STRINGP (specified_file
))
7230 Lisp_Object file
= x_find_image_file (specified_file
);
7231 if (!STRINGP (file
))
7233 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7237 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7238 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7243 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7244 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7245 XSTRING (buffer
)->data
,
7246 &img
->pixmap
, &img
->mask
,
7250 if (rc
== XpmSuccess
)
7252 #ifdef ALLOC_XPM_COLORS
7253 img
->colors
= colors_in_color_table (&img
->ncolors
);
7254 #else /* not ALLOC_XPM_COLORS */
7255 img
->ncolors
= attrs
.nalloc_pixels
;
7256 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7257 * sizeof *img
->colors
);
7258 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7260 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7261 #ifdef DEBUG_X_COLORS
7262 register_color (img
->colors
[i
]);
7265 #endif /* not ALLOC_XPM_COLORS */
7267 img
->width
= attrs
.width
;
7268 img
->height
= attrs
.height
;
7269 xassert (img
->width
> 0 && img
->height
> 0);
7271 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7272 XpmFreeAttributes (&attrs
);
7279 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7282 case XpmFileInvalid
:
7283 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7287 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7290 case XpmColorFailed
:
7291 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7295 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7300 #ifdef ALLOC_XPM_COLORS
7301 xpm_free_color_cache ();
7303 return rc
== XpmSuccess
;
7306 #endif /* HAVE_XPM != 0 */
7309 /***********************************************************************
7311 ***********************************************************************/
7313 /* An entry in the color table mapping an RGB color to a pixel color. */
7318 unsigned long pixel
;
7320 /* Next in color table collision list. */
7321 struct ct_color
*next
;
7324 /* The bucket vector size to use. Must be prime. */
7328 /* Value is a hash of the RGB color given by R, G, and B. */
7330 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7332 /* The color hash table. */
7334 struct ct_color
**ct_table
;
7336 /* Number of entries in the color table. */
7338 int ct_colors_allocated
;
7340 /* Initialize the color table. */
7345 int size
= CT_SIZE
* sizeof (*ct_table
);
7346 ct_table
= (struct ct_color
**) xmalloc (size
);
7347 bzero (ct_table
, size
);
7348 ct_colors_allocated
= 0;
7352 /* Free memory associated with the color table. */
7358 struct ct_color
*p
, *next
;
7360 for (i
= 0; i
< CT_SIZE
; ++i
)
7361 for (p
= ct_table
[i
]; p
; p
= next
)
7372 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7373 entry for that color already is in the color table, return the
7374 pixel color of that entry. Otherwise, allocate a new color for R,
7375 G, B, and make an entry in the color table. */
7377 static unsigned long
7378 lookup_rgb_color (f
, r
, g
, b
)
7382 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7383 int i
= hash
% CT_SIZE
;
7386 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7387 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7400 cmap
= FRAME_X_COLORMAP (f
);
7401 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7405 ++ct_colors_allocated
;
7407 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7411 p
->pixel
= color
.pixel
;
7412 p
->next
= ct_table
[i
];
7416 return FRAME_FOREGROUND_PIXEL (f
);
7423 /* Look up pixel color PIXEL which is used on frame F in the color
7424 table. If not already present, allocate it. Value is PIXEL. */
7426 static unsigned long
7427 lookup_pixel_color (f
, pixel
)
7429 unsigned long pixel
;
7431 int i
= pixel
% CT_SIZE
;
7434 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7435 if (p
->pixel
== pixel
)
7444 cmap
= FRAME_X_COLORMAP (f
);
7445 color
.pixel
= pixel
;
7446 x_query_color (f
, &color
);
7447 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7451 ++ct_colors_allocated
;
7453 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7458 p
->next
= ct_table
[i
];
7462 return FRAME_FOREGROUND_PIXEL (f
);
7469 /* Value is a vector of all pixel colors contained in the color table,
7470 allocated via xmalloc. Set *N to the number of colors. */
7472 static unsigned long *
7473 colors_in_color_table (n
)
7478 unsigned long *colors
;
7480 if (ct_colors_allocated
== 0)
7487 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7489 *n
= ct_colors_allocated
;
7491 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7492 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7493 colors
[j
++] = p
->pixel
;
7501 /***********************************************************************
7503 ***********************************************************************/
7505 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7506 int, XImage
*, int));
7507 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7508 XColor
*, int, XImage
*, int));
7509 static XColor
*x_to_xcolors
P_ ((struct frame
*, struct image
*, int));
7510 static void x_from_xcolors
P_ ((struct frame
*, struct image
*, XColor
*));
7511 static void x_detect_edges
P_ ((struct frame
*, struct image
*, int[9], int));
7513 /* Non-zero means draw a cross on images having `:algorithm
7516 int cross_disabled_images
;
7518 /* Edge detection matrices for different edge-detection
7521 static int emboss_matrix
[9] = {
7523 2, -1, 0, /* y - 1 */
7525 0, 1, -2 /* y + 1 */
7528 static int laplace_matrix
[9] = {
7530 1, 0, 0, /* y - 1 */
7532 0, 0, -1 /* y + 1 */
7535 /* Value is the intensity of the color whose red/green/blue values
7538 #define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7541 /* On frame F, return an array of XColor structures describing image
7542 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7543 non-zero means also fill the red/green/blue members of the XColor
7544 structures. Value is a pointer to the array of XColors structures,
7545 allocated with xmalloc; it must be freed by the caller. */
7548 x_to_xcolors (f
, img
, rgb_p
)
7557 colors
= (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *colors
);
7559 /* Get the X image IMG->pixmap. */
7560 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7561 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7563 /* Fill the `pixel' members of the XColor array. I wished there
7564 were an easy and portable way to circumvent XGetPixel. */
7566 for (y
= 0; y
< img
->height
; ++y
)
7570 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7571 p
->pixel
= XGetPixel (ximg
, x
, y
);
7574 x_query_colors (f
, row
, img
->width
);
7577 XDestroyImage (ximg
);
7582 /* Create IMG->pixmap from an array COLORS of XColor structures, whose
7583 RGB members are set. F is the frame on which this all happens.
7584 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
7587 x_from_xcolors (f
, img
, colors
)
7597 init_color_table ();
7599 x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7602 for (y
= 0; y
< img
->height
; ++y
)
7603 for (x
= 0; x
< img
->width
; ++x
, ++p
)
7605 unsigned long pixel
;
7606 pixel
= lookup_rgb_color (f
, p
->red
, p
->green
, p
->blue
);
7607 XPutPixel (oimg
, x
, y
, pixel
);
7611 x_clear_image_1 (f
, img
, 1, 0, 1);
7613 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7614 x_destroy_x_image (oimg
);
7615 img
->pixmap
= pixmap
;
7616 img
->colors
= colors_in_color_table (&img
->ncolors
);
7617 free_color_table ();
7621 /* On frame F, perform edge-detection on image IMG.
7623 MATRIX is a nine-element array specifying the transformation
7624 matrix. See emboss_matrix for an example.
7626 COLOR_ADJUST is a color adjustment added to each pixel of the
7630 x_detect_edges (f
, img
, matrix
, color_adjust
)
7633 int matrix
[9], color_adjust
;
7635 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7639 for (i
= sum
= 0; i
< 9; ++i
)
7640 sum
+= abs (matrix
[i
]);
7642 #define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
7644 new = (XColor
*) xmalloc (img
->width
* img
->height
* sizeof *new);
7646 for (y
= 0; y
< img
->height
; ++y
)
7648 p
= COLOR (new, 0, y
);
7649 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7650 p
= COLOR (new, img
->width
- 1, y
);
7651 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7654 for (x
= 1; x
< img
->width
- 1; ++x
)
7656 p
= COLOR (new, x
, 0);
7657 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7658 p
= COLOR (new, x
, img
->height
- 1);
7659 p
->red
= p
->green
= p
->blue
= 0xffff/2;
7662 for (y
= 1; y
< img
->height
- 1; ++y
)
7664 p
= COLOR (new, 1, y
);
7666 for (x
= 1; x
< img
->width
- 1; ++x
, ++p
)
7668 int r
, g
, b
, y1
, x1
;
7671 for (y1
= y
- 1; y1
< y
+ 2; ++y1
)
7672 for (x1
= x
- 1; x1
< x
+ 2; ++x1
, ++i
)
7675 XColor
*t
= COLOR (colors
, x1
, y1
);
7676 r
+= matrix
[i
] * t
->red
;
7677 g
+= matrix
[i
] * t
->green
;
7678 b
+= matrix
[i
] * t
->blue
;
7681 r
= (r
/ sum
+ color_adjust
) & 0xffff;
7682 g
= (g
/ sum
+ color_adjust
) & 0xffff;
7683 b
= (b
/ sum
+ color_adjust
) & 0xffff;
7684 p
->red
= p
->green
= p
->blue
= COLOR_INTENSITY (r
, g
, b
);
7689 x_from_xcolors (f
, img
, new);
7695 /* Perform the pre-defined `emboss' edge-detection on image IMG
7703 x_detect_edges (f
, img
, emboss_matrix
, 0xffff / 2);
7707 /* Perform the pre-defined `laplace' edge-detection on image IMG
7715 x_detect_edges (f
, img
, laplace_matrix
, 45000);
7719 /* Perform edge-detection on image IMG on frame F, with specified
7720 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7722 MATRIX must be either
7724 - a list of at least 9 numbers in row-major form
7725 - a vector of at least 9 numbers
7727 COLOR_ADJUST nil means use a default; otherwise it must be a
7731 x_edge_detection (f
, img
, matrix
, color_adjust
)
7734 Lisp_Object matrix
, color_adjust
;
7742 i
< 9 && CONSP (matrix
) && NUMBERP (XCAR (matrix
));
7743 ++i
, matrix
= XCDR (matrix
))
7744 trans
[i
] = XFLOATINT (XCAR (matrix
));
7746 else if (VECTORP (matrix
) && ASIZE (matrix
) >= 9)
7748 for (i
= 0; i
< 9 && NUMBERP (AREF (matrix
, i
)); ++i
)
7749 trans
[i
] = XFLOATINT (AREF (matrix
, i
));
7752 if (NILP (color_adjust
))
7753 color_adjust
= make_number (0xffff / 2);
7755 if (i
== 9 && NUMBERP (color_adjust
))
7756 x_detect_edges (f
, img
, trans
, (int) XFLOATINT (color_adjust
));
7760 /* Transform image IMG on frame F so that it looks disabled. */
7763 x_disable_image (f
, img
)
7767 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
7769 if (dpyinfo
->n_planes
>= 2)
7771 /* Color (or grayscale). Convert to gray, and equalize. Just
7772 drawing such images with a stipple can look very odd, so
7773 we're using this method instead. */
7774 XColor
*colors
= x_to_xcolors (f
, img
, 1);
7776 const int h
= 15000;
7777 const int l
= 30000;
7779 for (p
= colors
, end
= colors
+ img
->width
* img
->height
;
7783 int i
= COLOR_INTENSITY (p
->red
, p
->green
, p
->blue
);
7784 int i2
= (0xffff - h
- l
) * i
/ 0xffff + l
;
7785 p
->red
= p
->green
= p
->blue
= i2
;
7788 x_from_xcolors (f
, img
, colors
);
7791 /* Draw a cross over the disabled image, if we must or if we
7793 if (dpyinfo
->n_planes
< 2 || cross_disabled_images
)
7795 Display
*dpy
= FRAME_X_DISPLAY (f
);
7798 gc
= XCreateGC (dpy
, img
->pixmap
, 0, NULL
);
7799 XSetForeground (dpy
, gc
, BLACK_PIX_DEFAULT (f
));
7800 XDrawLine (dpy
, img
->pixmap
, gc
, 0, 0,
7801 img
->width
- 1, img
->height
- 1);
7802 XDrawLine (dpy
, img
->pixmap
, gc
, 0, img
->height
- 1,
7808 gc
= XCreateGC (dpy
, img
->mask
, 0, NULL
);
7809 XSetForeground (dpy
, gc
, WHITE_PIX_DEFAULT (f
));
7810 XDrawLine (dpy
, img
->mask
, gc
, 0, 0,
7811 img
->width
- 1, img
->height
- 1);
7812 XDrawLine (dpy
, img
->mask
, gc
, 0, img
->height
- 1,
7820 /* Build a mask for image IMG which is used on frame F. FILE is the
7821 name of an image file, for error messages. HOW determines how to
7822 determine the background color of IMG. If it is a list '(R G B)',
7823 with R, G, and B being integers >= 0, take that as the color of the
7824 background. Otherwise, determine the background color of IMG
7825 heuristically. Value is non-zero if successful. */
7828 x_build_heuristic_mask (f
, img
, how
)
7833 Display
*dpy
= FRAME_X_DISPLAY (f
);
7834 XImage
*ximg
, *mask_img
;
7835 int x
, y
, rc
, look_at_corners_p
;
7836 unsigned long bg
= 0;
7840 XFreePixmap (FRAME_X_DISPLAY (f
), img
->mask
);
7844 /* Create an image and pixmap serving as mask. */
7845 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7846 &mask_img
, &img
->mask
);
7850 /* Get the X image of IMG->pixmap. */
7851 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7854 /* Determine the background color of ximg. If HOW is `(R G B)'
7855 take that as color. Otherwise, try to determine the color
7857 look_at_corners_p
= 1;
7865 && NATNUMP (XCAR (how
)))
7867 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7871 if (i
== 3 && NILP (how
))
7873 char color_name
[30];
7874 XColor exact
, color
;
7877 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7879 cmap
= FRAME_X_COLORMAP (f
);
7880 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7883 look_at_corners_p
= 0;
7888 if (look_at_corners_p
)
7890 unsigned long corners
[4];
7893 /* Get the colors at the corners of ximg. */
7894 corners
[0] = XGetPixel (ximg
, 0, 0);
7895 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7896 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7897 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7899 /* Choose the most frequently found color as background. */
7900 for (i
= best_count
= 0; i
< 4; ++i
)
7904 for (j
= n
= 0; j
< 4; ++j
)
7905 if (corners
[i
] == corners
[j
])
7909 bg
= corners
[i
], best_count
= n
;
7913 /* Set all bits in mask_img to 1 whose color in ximg is different
7914 from the background color bg. */
7915 for (y
= 0; y
< img
->height
; ++y
)
7916 for (x
= 0; x
< img
->width
; ++x
)
7917 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7919 /* Put mask_img into img->mask. */
7920 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7921 x_destroy_x_image (mask_img
);
7922 XDestroyImage (ximg
);
7929 /***********************************************************************
7930 PBM (mono, gray, color)
7931 ***********************************************************************/
7933 static int pbm_image_p
P_ ((Lisp_Object object
));
7934 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7935 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7937 /* The symbol `pbm' identifying images of this type. */
7941 /* Indices of image specification fields in gs_format, below. */
7943 enum pbm_keyword_index
7959 /* Vector of image_keyword structures describing the format
7960 of valid user-defined image specifications. */
7962 static struct image_keyword pbm_format
[PBM_LAST
] =
7964 {":type", IMAGE_SYMBOL_VALUE
, 1},
7965 {":file", IMAGE_STRING_VALUE
, 0},
7966 {":data", IMAGE_STRING_VALUE
, 0},
7967 {":ascent", IMAGE_ASCENT_VALUE
, 0},
7968 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7969 {":relief", IMAGE_INTEGER_VALUE
, 0},
7970 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7971 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7972 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7973 {":foreground", IMAGE_STRING_VALUE
, 0},
7974 {":background", IMAGE_STRING_VALUE
, 0}
7977 /* Structure describing the image type `pbm'. */
7979 static struct image_type pbm_type
=
7989 /* Return non-zero if OBJECT is a valid PBM image specification. */
7992 pbm_image_p (object
)
7995 struct image_keyword fmt
[PBM_LAST
];
7997 bcopy (pbm_format
, fmt
, sizeof fmt
);
7999 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
))
8002 /* Must specify either :data or :file. */
8003 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
8007 /* Scan a decimal number from *S and return it. Advance *S while
8008 reading the number. END is the end of the string. Value is -1 at
8012 pbm_scan_number (s
, end
)
8013 unsigned char **s
, *end
;
8015 int c
= 0, val
= -1;
8019 /* Skip white-space. */
8020 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
8025 /* Skip comment to end of line. */
8026 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
8029 else if (isdigit (c
))
8031 /* Read decimal number. */
8033 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
8034 val
= 10 * val
+ c
- '0';
8045 /* Load PBM image IMG for use on frame F. */
8053 int width
, height
, max_color_idx
= 0;
8055 Lisp_Object file
, specified_file
;
8056 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
8057 struct gcpro gcpro1
;
8058 unsigned char *contents
= NULL
;
8059 unsigned char *end
, *p
;
8062 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8066 if (STRINGP (specified_file
))
8068 file
= x_find_image_file (specified_file
);
8069 if (!STRINGP (file
))
8071 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8076 contents
= slurp_file (XSTRING (file
)->data
, &size
);
8077 if (contents
== NULL
)
8079 image_error ("Error reading `%s'", file
, Qnil
);
8085 end
= contents
+ size
;
8090 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8091 p
= XSTRING (data
)->data
;
8092 end
= p
+ STRING_BYTES (XSTRING (data
));
8095 /* Check magic number. */
8096 if (end
- p
< 2 || *p
++ != 'P')
8098 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8108 raw_p
= 0, type
= PBM_MONO
;
8112 raw_p
= 0, type
= PBM_GRAY
;
8116 raw_p
= 0, type
= PBM_COLOR
;
8120 raw_p
= 1, type
= PBM_MONO
;
8124 raw_p
= 1, type
= PBM_GRAY
;
8128 raw_p
= 1, type
= PBM_COLOR
;
8132 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
8136 /* Read width, height, maximum color-component. Characters
8137 starting with `#' up to the end of a line are ignored. */
8138 width
= pbm_scan_number (&p
, end
);
8139 height
= pbm_scan_number (&p
, end
);
8141 if (type
!= PBM_MONO
)
8143 max_color_idx
= pbm_scan_number (&p
, end
);
8144 if (raw_p
&& max_color_idx
> 255)
8145 max_color_idx
= 255;
8150 || (type
!= PBM_MONO
&& max_color_idx
< 0))
8153 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
8154 &ximg
, &img
->pixmap
))
8157 /* Initialize the color hash table. */
8158 init_color_table ();
8160 if (type
== PBM_MONO
)
8163 struct image_keyword fmt
[PBM_LAST
];
8164 unsigned long fg
= FRAME_FOREGROUND_PIXEL (f
);
8165 unsigned long bg
= FRAME_BACKGROUND_PIXEL (f
);
8167 /* Parse the image specification. */
8168 bcopy (pbm_format
, fmt
, sizeof fmt
);
8169 parse_image_spec (img
->spec
, fmt
, PBM_LAST
, Qpbm
);
8171 /* Get foreground and background colors, maybe allocate colors. */
8172 if (fmt
[PBM_FOREGROUND
].count
)
8173 fg
= x_alloc_image_color (f
, img
, fmt
[PBM_FOREGROUND
].value
, fg
);
8174 if (fmt
[PBM_BACKGROUND
].count
)
8175 bg
= x_alloc_image_color (f
, img
, fmt
[PBM_BACKGROUND
].value
, bg
);
8177 for (y
= 0; y
< height
; ++y
)
8178 for (x
= 0; x
< width
; ++x
)
8188 g
= pbm_scan_number (&p
, end
);
8190 XPutPixel (ximg
, x
, y
, g
? fg
: bg
);
8195 for (y
= 0; y
< height
; ++y
)
8196 for (x
= 0; x
< width
; ++x
)
8200 if (type
== PBM_GRAY
)
8201 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
8210 r
= pbm_scan_number (&p
, end
);
8211 g
= pbm_scan_number (&p
, end
);
8212 b
= pbm_scan_number (&p
, end
);
8215 if (r
< 0 || g
< 0 || b
< 0)
8219 XDestroyImage (ximg
);
8220 image_error ("Invalid pixel value in image `%s'",
8225 /* RGB values are now in the range 0..max_color_idx.
8226 Scale this to the range 0..0xffff supported by X. */
8227 r
= (double) r
* 65535 / max_color_idx
;
8228 g
= (double) g
* 65535 / max_color_idx
;
8229 b
= (double) b
* 65535 / max_color_idx
;
8230 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8234 /* Store in IMG->colors the colors allocated for the image, and
8235 free the color table. */
8236 img
->colors
= colors_in_color_table (&img
->ncolors
);
8237 free_color_table ();
8239 /* Put the image into a pixmap. */
8240 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8241 x_destroy_x_image (ximg
);
8244 img
->height
= height
;
8253 /***********************************************************************
8255 ***********************************************************************/
8261 /* Function prototypes. */
8263 static int png_image_p
P_ ((Lisp_Object object
));
8264 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
8266 /* The symbol `png' identifying images of this type. */
8270 /* Indices of image specification fields in png_format, below. */
8272 enum png_keyword_index
8286 /* Vector of image_keyword structures describing the format
8287 of valid user-defined image specifications. */
8289 static struct image_keyword png_format
[PNG_LAST
] =
8291 {":type", IMAGE_SYMBOL_VALUE
, 1},
8292 {":data", IMAGE_STRING_VALUE
, 0},
8293 {":file", IMAGE_STRING_VALUE
, 0},
8294 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8295 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8296 {":relief", IMAGE_INTEGER_VALUE
, 0},
8297 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8298 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8299 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8302 /* Structure describing the image type `png'. */
8304 static struct image_type png_type
=
8314 /* Return non-zero if OBJECT is a valid PNG image specification. */
8317 png_image_p (object
)
8320 struct image_keyword fmt
[PNG_LAST
];
8321 bcopy (png_format
, fmt
, sizeof fmt
);
8323 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
))
8326 /* Must specify either the :data or :file keyword. */
8327 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8331 /* Error and warning handlers installed when the PNG library
8335 my_png_error (png_ptr
, msg
)
8336 png_struct
*png_ptr
;
8339 xassert (png_ptr
!= NULL
);
8340 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8341 longjmp (png_ptr
->jmpbuf
, 1);
8346 my_png_warning (png_ptr
, msg
)
8347 png_struct
*png_ptr
;
8350 xassert (png_ptr
!= NULL
);
8351 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8354 /* Memory source for PNG decoding. */
8356 struct png_memory_storage
8358 unsigned char *bytes
; /* The data */
8359 size_t len
; /* How big is it? */
8360 int index
; /* Where are we? */
8364 /* Function set as reader function when reading PNG image from memory.
8365 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8366 bytes from the input to DATA. */
8369 png_read_from_memory (png_ptr
, data
, length
)
8370 png_structp png_ptr
;
8374 struct png_memory_storage
*tbr
8375 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8377 if (length
> tbr
->len
- tbr
->index
)
8378 png_error (png_ptr
, "Read error");
8380 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8381 tbr
->index
= tbr
->index
+ length
;
8384 /* Load PNG image IMG for use on frame F. Value is non-zero if
8392 Lisp_Object file
, specified_file
;
8393 Lisp_Object specified_data
;
8395 XImage
*ximg
, *mask_img
= NULL
;
8396 struct gcpro gcpro1
;
8397 png_struct
*png_ptr
= NULL
;
8398 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8399 FILE *volatile fp
= NULL
;
8401 png_byte
* volatile pixels
= NULL
;
8402 png_byte
** volatile rows
= NULL
;
8403 png_uint_32 width
, height
;
8404 int bit_depth
, color_type
, interlace_type
;
8406 png_uint_32 row_bytes
;
8409 double screen_gamma
, image_gamma
;
8411 struct png_memory_storage tbr
; /* Data to be read */
8413 /* Find out what file to load. */
8414 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8415 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8419 if (NILP (specified_data
))
8421 file
= x_find_image_file (specified_file
);
8422 if (!STRINGP (file
))
8424 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8429 /* Open the image file. */
8430 fp
= fopen (XSTRING (file
)->data
, "rb");
8433 image_error ("Cannot open image file `%s'", file
, Qnil
);
8439 /* Check PNG signature. */
8440 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8441 || !png_check_sig (sig
, sizeof sig
))
8443 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8451 /* Read from memory. */
8452 tbr
.bytes
= XSTRING (specified_data
)->data
;
8453 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8456 /* Check PNG signature. */
8457 if (tbr
.len
< sizeof sig
8458 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8460 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8465 /* Need to skip past the signature. */
8466 tbr
.bytes
+= sizeof (sig
);
8469 /* Initialize read and info structs for PNG lib. */
8470 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8471 my_png_error
, my_png_warning
);
8474 if (fp
) fclose (fp
);
8479 info_ptr
= png_create_info_struct (png_ptr
);
8482 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8483 if (fp
) fclose (fp
);
8488 end_info
= png_create_info_struct (png_ptr
);
8491 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8492 if (fp
) fclose (fp
);
8497 /* Set error jump-back. We come back here when the PNG library
8498 detects an error. */
8499 if (setjmp (png_ptr
->jmpbuf
))
8503 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8506 if (fp
) fclose (fp
);
8511 /* Read image info. */
8512 if (!NILP (specified_data
))
8513 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8515 png_init_io (png_ptr
, fp
);
8517 png_set_sig_bytes (png_ptr
, sizeof sig
);
8518 png_read_info (png_ptr
, info_ptr
);
8519 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8520 &interlace_type
, NULL
, NULL
);
8522 /* If image contains simply transparency data, we prefer to
8523 construct a clipping mask. */
8524 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8529 /* This function is easier to write if we only have to handle
8530 one data format: RGB or RGBA with 8 bits per channel. Let's
8531 transform other formats into that format. */
8533 /* Strip more than 8 bits per channel. */
8534 if (bit_depth
== 16)
8535 png_set_strip_16 (png_ptr
);
8537 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8539 png_set_expand (png_ptr
);
8541 /* Convert grayscale images to RGB. */
8542 if (color_type
== PNG_COLOR_TYPE_GRAY
8543 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8544 png_set_gray_to_rgb (png_ptr
);
8546 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8547 gamma_str
= getenv ("SCREEN_GAMMA");
8548 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8550 /* Tell the PNG lib to handle gamma correction for us. */
8552 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8553 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8554 /* There is a special chunk in the image specifying the gamma. */
8555 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8558 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8559 /* Image contains gamma information. */
8560 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8562 /* Use a default of 0.5 for the image gamma. */
8563 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8565 /* Handle alpha channel by combining the image with a background
8566 color. Do this only if a real alpha channel is supplied. For
8567 simple transparency, we prefer a clipping mask. */
8570 png_color_16
*image_background
;
8572 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8573 /* Image contains a background color with which to
8574 combine the image. */
8575 png_set_background (png_ptr
, image_background
,
8576 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8579 /* Image does not contain a background color with which
8580 to combine the image data via an alpha channel. Use
8581 the frame's background instead. */
8584 png_color_16 frame_background
;
8586 cmap
= FRAME_X_COLORMAP (f
);
8587 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8588 x_query_color (f
, &color
);
8590 bzero (&frame_background
, sizeof frame_background
);
8591 frame_background
.red
= color
.red
;
8592 frame_background
.green
= color
.green
;
8593 frame_background
.blue
= color
.blue
;
8595 png_set_background (png_ptr
, &frame_background
,
8596 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8600 /* Update info structure. */
8601 png_read_update_info (png_ptr
, info_ptr
);
8603 /* Get number of channels. Valid values are 1 for grayscale images
8604 and images with a palette, 2 for grayscale images with transparency
8605 information (alpha channel), 3 for RGB images, and 4 for RGB
8606 images with alpha channel, i.e. RGBA. If conversions above were
8607 sufficient we should only have 3 or 4 channels here. */
8608 channels
= png_get_channels (png_ptr
, info_ptr
);
8609 xassert (channels
== 3 || channels
== 4);
8611 /* Number of bytes needed for one row of the image. */
8612 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8614 /* Allocate memory for the image. */
8615 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8616 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8617 for (i
= 0; i
< height
; ++i
)
8618 rows
[i
] = pixels
+ i
* row_bytes
;
8620 /* Read the entire image. */
8621 png_read_image (png_ptr
, rows
);
8622 png_read_end (png_ptr
, info_ptr
);
8629 /* Create the X image and pixmap. */
8630 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8634 /* Create an image and pixmap serving as mask if the PNG image
8635 contains an alpha channel. */
8638 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8639 &mask_img
, &img
->mask
))
8641 x_destroy_x_image (ximg
);
8642 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8647 /* Fill the X image and mask from PNG data. */
8648 init_color_table ();
8650 for (y
= 0; y
< height
; ++y
)
8652 png_byte
*p
= rows
[y
];
8654 for (x
= 0; x
< width
; ++x
)
8661 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8663 /* An alpha channel, aka mask channel, associates variable
8664 transparency with an image. Where other image formats
8665 support binary transparency---fully transparent or fully
8666 opaque---PNG allows up to 254 levels of partial transparency.
8667 The PNG library implements partial transparency by combining
8668 the image with a specified background color.
8670 I'm not sure how to handle this here nicely: because the
8671 background on which the image is displayed may change, for
8672 real alpha channel support, it would be necessary to create
8673 a new image for each possible background.
8675 What I'm doing now is that a mask is created if we have
8676 boolean transparency information. Otherwise I'm using
8677 the frame's background color to combine the image with. */
8682 XPutPixel (mask_img
, x
, y
, *p
> 0);
8688 /* Remember colors allocated for this image. */
8689 img
->colors
= colors_in_color_table (&img
->ncolors
);
8690 free_color_table ();
8693 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8698 img
->height
= height
;
8700 /* Put the image into the pixmap, then free the X image and its buffer. */
8701 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8702 x_destroy_x_image (ximg
);
8704 /* Same for the mask. */
8707 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8708 x_destroy_x_image (mask_img
);
8715 #endif /* HAVE_PNG != 0 */
8719 /***********************************************************************
8721 ***********************************************************************/
8725 /* Work around a warning about HAVE_STDLIB_H being redefined in
8727 #ifdef HAVE_STDLIB_H
8728 #define HAVE_STDLIB_H_1
8729 #undef HAVE_STDLIB_H
8730 #endif /* HAVE_STLIB_H */
8732 #include <jpeglib.h>
8736 #ifdef HAVE_STLIB_H_1
8737 #define HAVE_STDLIB_H 1
8740 static int jpeg_image_p
P_ ((Lisp_Object object
));
8741 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8743 /* The symbol `jpeg' identifying images of this type. */
8747 /* Indices of image specification fields in gs_format, below. */
8749 enum jpeg_keyword_index
8758 JPEG_HEURISTIC_MASK
,
8763 /* Vector of image_keyword structures describing the format
8764 of valid user-defined image specifications. */
8766 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8768 {":type", IMAGE_SYMBOL_VALUE
, 1},
8769 {":data", IMAGE_STRING_VALUE
, 0},
8770 {":file", IMAGE_STRING_VALUE
, 0},
8771 {":ascent", IMAGE_ASCENT_VALUE
, 0},
8772 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8773 {":relief", IMAGE_INTEGER_VALUE
, 0},
8774 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8775 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8776 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8779 /* Structure describing the image type `jpeg'. */
8781 static struct image_type jpeg_type
=
8791 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8794 jpeg_image_p (object
)
8797 struct image_keyword fmt
[JPEG_LAST
];
8799 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8801 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
))
8804 /* Must specify either the :data or :file keyword. */
8805 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8809 struct my_jpeg_error_mgr
8811 struct jpeg_error_mgr pub
;
8812 jmp_buf setjmp_buffer
;
8817 my_error_exit (cinfo
)
8820 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8821 longjmp (mgr
->setjmp_buffer
, 1);
8825 /* Init source method for JPEG data source manager. Called by
8826 jpeg_read_header() before any data is actually read. See
8827 libjpeg.doc from the JPEG lib distribution. */
8830 our_init_source (cinfo
)
8831 j_decompress_ptr cinfo
;
8836 /* Fill input buffer method for JPEG data source manager. Called
8837 whenever more data is needed. We read the whole image in one step,
8838 so this only adds a fake end of input marker at the end. */
8841 our_fill_input_buffer (cinfo
)
8842 j_decompress_ptr cinfo
;
8844 /* Insert a fake EOI marker. */
8845 struct jpeg_source_mgr
*src
= cinfo
->src
;
8846 static JOCTET buffer
[2];
8848 buffer
[0] = (JOCTET
) 0xFF;
8849 buffer
[1] = (JOCTET
) JPEG_EOI
;
8851 src
->next_input_byte
= buffer
;
8852 src
->bytes_in_buffer
= 2;
8857 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8858 is the JPEG data source manager. */
8861 our_skip_input_data (cinfo
, num_bytes
)
8862 j_decompress_ptr cinfo
;
8865 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8869 if (num_bytes
> src
->bytes_in_buffer
)
8870 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8872 src
->bytes_in_buffer
-= num_bytes
;
8873 src
->next_input_byte
+= num_bytes
;
8878 /* Method to terminate data source. Called by
8879 jpeg_finish_decompress() after all data has been processed. */
8882 our_term_source (cinfo
)
8883 j_decompress_ptr cinfo
;
8888 /* Set up the JPEG lib for reading an image from DATA which contains
8889 LEN bytes. CINFO is the decompression info structure created for
8890 reading the image. */
8893 jpeg_memory_src (cinfo
, data
, len
)
8894 j_decompress_ptr cinfo
;
8898 struct jpeg_source_mgr
*src
;
8900 if (cinfo
->src
== NULL
)
8902 /* First time for this JPEG object? */
8903 cinfo
->src
= (struct jpeg_source_mgr
*)
8904 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8905 sizeof (struct jpeg_source_mgr
));
8906 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8907 src
->next_input_byte
= data
;
8910 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8911 src
->init_source
= our_init_source
;
8912 src
->fill_input_buffer
= our_fill_input_buffer
;
8913 src
->skip_input_data
= our_skip_input_data
;
8914 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8915 src
->term_source
= our_term_source
;
8916 src
->bytes_in_buffer
= len
;
8917 src
->next_input_byte
= data
;
8921 /* Load image IMG for use on frame F. Patterned after example.c
8922 from the JPEG lib. */
8929 struct jpeg_decompress_struct cinfo
;
8930 struct my_jpeg_error_mgr mgr
;
8931 Lisp_Object file
, specified_file
;
8932 Lisp_Object specified_data
;
8933 FILE * volatile fp
= NULL
;
8935 int row_stride
, x
, y
;
8936 XImage
*ximg
= NULL
;
8938 unsigned long *colors
;
8940 struct gcpro gcpro1
;
8942 /* Open the JPEG file. */
8943 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8944 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8948 if (NILP (specified_data
))
8950 file
= x_find_image_file (specified_file
);
8951 if (!STRINGP (file
))
8953 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8958 fp
= fopen (XSTRING (file
)->data
, "r");
8961 image_error ("Cannot open `%s'", file
, Qnil
);
8967 /* Customize libjpeg's error handling to call my_error_exit when an
8968 error is detected. This function will perform a longjmp. */
8969 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8970 mgr
.pub
.error_exit
= my_error_exit
;
8972 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8976 /* Called from my_error_exit. Display a JPEG error. */
8977 char buffer
[JMSG_LENGTH_MAX
];
8978 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8979 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8980 build_string (buffer
));
8983 /* Close the input file and destroy the JPEG object. */
8985 fclose ((FILE *) fp
);
8986 jpeg_destroy_decompress (&cinfo
);
8988 /* If we already have an XImage, free that. */
8989 x_destroy_x_image (ximg
);
8991 /* Free pixmap and colors. */
8992 x_clear_image (f
, img
);
8998 /* Create the JPEG decompression object. Let it read from fp.
8999 Read the JPEG image header. */
9000 jpeg_create_decompress (&cinfo
);
9002 if (NILP (specified_data
))
9003 jpeg_stdio_src (&cinfo
, (FILE *) fp
);
9005 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
9006 STRING_BYTES (XSTRING (specified_data
)));
9008 jpeg_read_header (&cinfo
, TRUE
);
9010 /* Customize decompression so that color quantization will be used.
9011 Start decompression. */
9012 cinfo
.quantize_colors
= TRUE
;
9013 jpeg_start_decompress (&cinfo
);
9014 width
= img
->width
= cinfo
.output_width
;
9015 height
= img
->height
= cinfo
.output_height
;
9017 /* Create X image and pixmap. */
9018 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9019 longjmp (mgr
.setjmp_buffer
, 2);
9021 /* Allocate colors. When color quantization is used,
9022 cinfo.actual_number_of_colors has been set with the number of
9023 colors generated, and cinfo.colormap is a two-dimensional array
9024 of color indices in the range 0..cinfo.actual_number_of_colors.
9025 No more than 255 colors will be generated. */
9029 if (cinfo
.out_color_components
> 2)
9030 ir
= 0, ig
= 1, ib
= 2;
9031 else if (cinfo
.out_color_components
> 1)
9032 ir
= 0, ig
= 1, ib
= 0;
9034 ir
= 0, ig
= 0, ib
= 0;
9036 /* Use the color table mechanism because it handles colors that
9037 cannot be allocated nicely. Such colors will be replaced with
9038 a default color, and we don't have to care about which colors
9039 can be freed safely, and which can't. */
9040 init_color_table ();
9041 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
9044 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
9046 /* Multiply RGB values with 255 because X expects RGB values
9047 in the range 0..0xffff. */
9048 int r
= cinfo
.colormap
[ir
][i
] << 8;
9049 int g
= cinfo
.colormap
[ig
][i
] << 8;
9050 int b
= cinfo
.colormap
[ib
][i
] << 8;
9051 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9054 /* Remember those colors actually allocated. */
9055 img
->colors
= colors_in_color_table (&img
->ncolors
);
9056 free_color_table ();
9060 row_stride
= width
* cinfo
.output_components
;
9061 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
9063 for (y
= 0; y
< height
; ++y
)
9065 jpeg_read_scanlines (&cinfo
, buffer
, 1);
9066 for (x
= 0; x
< cinfo
.output_width
; ++x
)
9067 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
9071 jpeg_finish_decompress (&cinfo
);
9072 jpeg_destroy_decompress (&cinfo
);
9074 fclose ((FILE *) fp
);
9076 /* Put the image into the pixmap. */
9077 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9078 x_destroy_x_image (ximg
);
9083 #endif /* HAVE_JPEG */
9087 /***********************************************************************
9089 ***********************************************************************/
9095 static int tiff_image_p
P_ ((Lisp_Object object
));
9096 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
9098 /* The symbol `tiff' identifying images of this type. */
9102 /* Indices of image specification fields in tiff_format, below. */
9104 enum tiff_keyword_index
9113 TIFF_HEURISTIC_MASK
,
9118 /* Vector of image_keyword structures describing the format
9119 of valid user-defined image specifications. */
9121 static struct image_keyword tiff_format
[TIFF_LAST
] =
9123 {":type", IMAGE_SYMBOL_VALUE
, 1},
9124 {":data", IMAGE_STRING_VALUE
, 0},
9125 {":file", IMAGE_STRING_VALUE
, 0},
9126 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9127 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9128 {":relief", IMAGE_INTEGER_VALUE
, 0},
9129 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9130 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9131 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9134 /* Structure describing the image type `tiff'. */
9136 static struct image_type tiff_type
=
9146 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9149 tiff_image_p (object
)
9152 struct image_keyword fmt
[TIFF_LAST
];
9153 bcopy (tiff_format
, fmt
, sizeof fmt
);
9155 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
))
9158 /* Must specify either the :data or :file keyword. */
9159 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
9163 /* Reading from a memory buffer for TIFF images Based on the PNG
9164 memory source, but we have to provide a lot of extra functions.
9167 We really only need to implement read and seek, but I am not
9168 convinced that the TIFF library is smart enough not to destroy
9169 itself if we only hand it the function pointers we need to
9174 unsigned char *bytes
;
9182 tiff_read_from_memory (data
, buf
, size
)
9187 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9189 if (size
> src
->len
- src
->index
)
9191 bcopy (src
->bytes
+ src
->index
, buf
, size
);
9198 tiff_write_from_memory (data
, buf
, size
)
9208 tiff_seek_in_memory (data
, off
, whence
)
9213 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
9218 case SEEK_SET
: /* Go from beginning of source. */
9222 case SEEK_END
: /* Go from end of source. */
9223 idx
= src
->len
+ off
;
9226 case SEEK_CUR
: /* Go from current position. */
9227 idx
= src
->index
+ off
;
9230 default: /* Invalid `whence'. */
9234 if (idx
> src
->len
|| idx
< 0)
9243 tiff_close_memory (data
)
9252 tiff_mmap_memory (data
, pbase
, psize
)
9257 /* It is already _IN_ memory. */
9263 tiff_unmap_memory (data
, base
, size
)
9268 /* We don't need to do this. */
9273 tiff_size_of_memory (data
)
9276 return ((tiff_memory_source
*) data
)->len
;
9280 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9288 Lisp_Object file
, specified_file
;
9289 Lisp_Object specified_data
;
9291 int width
, height
, x
, y
;
9295 struct gcpro gcpro1
;
9296 tiff_memory_source memsrc
;
9298 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9299 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9303 if (NILP (specified_data
))
9305 /* Read from a file */
9306 file
= x_find_image_file (specified_file
);
9307 if (!STRINGP (file
))
9309 image_error ("Cannot find image file `%s'", file
, Qnil
);
9314 /* Try to open the image file. */
9315 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9318 image_error ("Cannot open `%s'", file
, Qnil
);
9325 /* Memory source! */
9326 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9327 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9330 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9331 (TIFFReadWriteProc
) tiff_read_from_memory
,
9332 (TIFFReadWriteProc
) tiff_write_from_memory
,
9333 tiff_seek_in_memory
,
9335 tiff_size_of_memory
,
9341 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9347 /* Get width and height of the image, and allocate a raster buffer
9348 of width x height 32-bit values. */
9349 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9350 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9351 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9353 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9357 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9363 /* Create the X image and pixmap. */
9364 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9371 /* Initialize the color table. */
9372 init_color_table ();
9374 /* Process the pixel raster. Origin is in the lower-left corner. */
9375 for (y
= 0; y
< height
; ++y
)
9377 uint32
*row
= buf
+ y
* width
;
9379 for (x
= 0; x
< width
; ++x
)
9381 uint32 abgr
= row
[x
];
9382 int r
= TIFFGetR (abgr
) << 8;
9383 int g
= TIFFGetG (abgr
) << 8;
9384 int b
= TIFFGetB (abgr
) << 8;
9385 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9389 /* Remember the colors allocated for the image. Free the color table. */
9390 img
->colors
= colors_in_color_table (&img
->ncolors
);
9391 free_color_table ();
9393 /* Put the image into the pixmap, then free the X image and its buffer. */
9394 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9395 x_destroy_x_image (ximg
);
9399 img
->height
= height
;
9405 #endif /* HAVE_TIFF != 0 */
9409 /***********************************************************************
9411 ***********************************************************************/
9415 #include <gif_lib.h>
9417 static int gif_image_p
P_ ((Lisp_Object object
));
9418 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9420 /* The symbol `gif' identifying images of this type. */
9424 /* Indices of image specification fields in gif_format, below. */
9426 enum gif_keyword_index
9441 /* Vector of image_keyword structures describing the format
9442 of valid user-defined image specifications. */
9444 static struct image_keyword gif_format
[GIF_LAST
] =
9446 {":type", IMAGE_SYMBOL_VALUE
, 1},
9447 {":data", IMAGE_STRING_VALUE
, 0},
9448 {":file", IMAGE_STRING_VALUE
, 0},
9449 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9450 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9451 {":relief", IMAGE_INTEGER_VALUE
, 0},
9452 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9453 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9454 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9455 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9458 /* Structure describing the image type `gif'. */
9460 static struct image_type gif_type
=
9470 /* Return non-zero if OBJECT is a valid GIF image specification. */
9473 gif_image_p (object
)
9476 struct image_keyword fmt
[GIF_LAST
];
9477 bcopy (gif_format
, fmt
, sizeof fmt
);
9479 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
))
9482 /* Must specify either the :data or :file keyword. */
9483 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9487 /* Reading a GIF image from memory
9488 Based on the PNG memory stuff to a certain extent. */
9492 unsigned char *bytes
;
9499 /* Make the current memory source available to gif_read_from_memory.
9500 It's done this way because not all versions of libungif support
9501 a UserData field in the GifFileType structure. */
9502 static gif_memory_source
*current_gif_memory_src
;
9505 gif_read_from_memory (file
, buf
, len
)
9510 gif_memory_source
*src
= current_gif_memory_src
;
9512 if (len
> src
->len
- src
->index
)
9515 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9521 /* Load GIF image IMG for use on frame F. Value is non-zero if
9529 Lisp_Object file
, specified_file
;
9530 Lisp_Object specified_data
;
9531 int rc
, width
, height
, x
, y
, i
;
9533 ColorMapObject
*gif_color_map
;
9534 unsigned long pixel_colors
[256];
9536 struct gcpro gcpro1
;
9538 int ino
, image_left
, image_top
, image_width
, image_height
;
9539 gif_memory_source memsrc
;
9540 unsigned char *raster
;
9542 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9543 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9547 if (NILP (specified_data
))
9549 file
= x_find_image_file (specified_file
);
9550 if (!STRINGP (file
))
9552 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9557 /* Open the GIF file. */
9558 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9561 image_error ("Cannot open `%s'", file
, Qnil
);
9568 /* Read from memory! */
9569 current_gif_memory_src
= &memsrc
;
9570 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9571 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9574 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9577 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9583 /* Read entire contents. */
9584 rc
= DGifSlurp (gif
);
9585 if (rc
== GIF_ERROR
)
9587 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9588 DGifCloseFile (gif
);
9593 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9594 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9595 if (ino
>= gif
->ImageCount
)
9597 image_error ("Invalid image number `%s' in image `%s'",
9599 DGifCloseFile (gif
);
9604 width
= img
->width
= gif
->SWidth
;
9605 height
= img
->height
= gif
->SHeight
;
9607 /* Create the X image and pixmap. */
9608 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9610 DGifCloseFile (gif
);
9615 /* Allocate colors. */
9616 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9618 gif_color_map
= gif
->SColorMap
;
9619 init_color_table ();
9620 bzero (pixel_colors
, sizeof pixel_colors
);
9622 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9624 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9625 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9626 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9627 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9630 img
->colors
= colors_in_color_table (&img
->ncolors
);
9631 free_color_table ();
9633 /* Clear the part of the screen image that are not covered by
9634 the image from the GIF file. Full animated GIF support
9635 requires more than can be done here (see the gif89 spec,
9636 disposal methods). Let's simply assume that the part
9637 not covered by a sub-image is in the frame's background color. */
9638 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9639 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9640 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9641 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9643 for (y
= 0; y
< image_top
; ++y
)
9644 for (x
= 0; x
< width
; ++x
)
9645 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9647 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9648 for (x
= 0; x
< width
; ++x
)
9649 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9651 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9653 for (x
= 0; x
< image_left
; ++x
)
9654 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9655 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9656 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9659 /* Read the GIF image into the X image. We use a local variable
9660 `raster' here because RasterBits below is a char *, and invites
9661 problems with bytes >= 0x80. */
9662 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9664 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9666 static int interlace_start
[] = {0, 4, 2, 1};
9667 static int interlace_increment
[] = {8, 8, 4, 2};
9669 int row
= interlace_start
[0];
9673 for (y
= 0; y
< image_height
; y
++)
9675 if (row
>= image_height
)
9677 row
= interlace_start
[++pass
];
9678 while (row
>= image_height
)
9679 row
= interlace_start
[++pass
];
9682 for (x
= 0; x
< image_width
; x
++)
9684 int i
= raster
[(y
* image_width
) + x
];
9685 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9689 row
+= interlace_increment
[pass
];
9694 for (y
= 0; y
< image_height
; ++y
)
9695 for (x
= 0; x
< image_width
; ++x
)
9697 int i
= raster
[y
* image_width
+ x
];
9698 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9702 DGifCloseFile (gif
);
9704 /* Put the image into the pixmap, then free the X image and its buffer. */
9705 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9706 x_destroy_x_image (ximg
);
9712 #endif /* HAVE_GIF != 0 */
9716 /***********************************************************************
9718 ***********************************************************************/
9720 static int gs_image_p
P_ ((Lisp_Object object
));
9721 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9722 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9724 /* The symbol `postscript' identifying images of this type. */
9726 Lisp_Object Qpostscript
;
9728 /* Keyword symbols. */
9730 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9732 /* Indices of image specification fields in gs_format, below. */
9734 enum gs_keyword_index
9751 /* Vector of image_keyword structures describing the format
9752 of valid user-defined image specifications. */
9754 static struct image_keyword gs_format
[GS_LAST
] =
9756 {":type", IMAGE_SYMBOL_VALUE
, 1},
9757 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9758 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9759 {":file", IMAGE_STRING_VALUE
, 1},
9760 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9761 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9762 {":ascent", IMAGE_ASCENT_VALUE
, 0},
9763 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9764 {":relief", IMAGE_INTEGER_VALUE
, 0},
9765 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9766 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9767 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9770 /* Structure describing the image type `ghostscript'. */
9772 static struct image_type gs_type
=
9782 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9785 gs_clear_image (f
, img
)
9789 /* IMG->data.ptr_val may contain a recorded colormap. */
9790 xfree (img
->data
.ptr_val
);
9791 x_clear_image (f
, img
);
9795 /* Return non-zero if OBJECT is a valid Ghostscript image
9802 struct image_keyword fmt
[GS_LAST
];
9806 bcopy (gs_format
, fmt
, sizeof fmt
);
9808 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
))
9811 /* Bounding box must be a list or vector containing 4 integers. */
9812 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9815 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9816 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9821 else if (VECTORP (tem
))
9823 if (XVECTOR (tem
)->size
!= 4)
9825 for (i
= 0; i
< 4; ++i
)
9826 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9836 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9845 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9846 struct gcpro gcpro1
, gcpro2
;
9848 double in_width
, in_height
;
9849 Lisp_Object pixel_colors
= Qnil
;
9851 /* Compute pixel size of pixmap needed from the given size in the
9852 image specification. Sizes in the specification are in pt. 1 pt
9853 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9855 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9856 in_width
= XFASTINT (pt_width
) / 72.0;
9857 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9858 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9859 in_height
= XFASTINT (pt_height
) / 72.0;
9860 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9862 /* Create the pixmap. */
9863 xassert (img
->pixmap
== None
);
9864 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9865 img
->width
, img
->height
,
9866 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9870 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9874 /* Call the loader to fill the pixmap. It returns a process object
9875 if successful. We do not record_unwind_protect here because
9876 other places in redisplay like calling window scroll functions
9877 don't either. Let the Lisp loader use `unwind-protect' instead. */
9878 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9880 sprintf (buffer
, "%lu %lu",
9881 (unsigned long) FRAME_X_WINDOW (f
),
9882 (unsigned long) img
->pixmap
);
9883 window_and_pixmap_id
= build_string (buffer
);
9885 sprintf (buffer
, "%lu %lu",
9886 FRAME_FOREGROUND_PIXEL (f
),
9887 FRAME_BACKGROUND_PIXEL (f
));
9888 pixel_colors
= build_string (buffer
);
9890 XSETFRAME (frame
, f
);
9891 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9893 loader
= intern ("gs-load-image");
9895 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9896 make_number (img
->width
),
9897 make_number (img
->height
),
9898 window_and_pixmap_id
,
9901 return PROCESSP (img
->data
.lisp_val
);
9905 /* Kill the Ghostscript process that was started to fill PIXMAP on
9906 frame F. Called from XTread_socket when receiving an event
9907 telling Emacs that Ghostscript has finished drawing. */
9910 x_kill_gs_process (pixmap
, f
)
9914 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9918 /* Find the image containing PIXMAP. */
9919 for (i
= 0; i
< c
->used
; ++i
)
9920 if (c
->images
[i
]->pixmap
== pixmap
)
9923 /* Kill the GS process. We should have found PIXMAP in the image
9924 cache and its image should contain a process object. */
9925 xassert (i
< c
->used
);
9927 xassert (PROCESSP (img
->data
.lisp_val
));
9928 Fkill_process (img
->data
.lisp_val
, Qnil
);
9929 img
->data
.lisp_val
= Qnil
;
9931 /* On displays with a mutable colormap, figure out the colors
9932 allocated for the image by looking at the pixels of an XImage for
9934 class = FRAME_X_VISUAL (f
)->class;
9935 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9941 /* Try to get an XImage for img->pixmep. */
9942 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9943 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9948 /* Initialize the color table. */
9949 init_color_table ();
9951 /* For each pixel of the image, look its color up in the
9952 color table. After having done so, the color table will
9953 contain an entry for each color used by the image. */
9954 for (y
= 0; y
< img
->height
; ++y
)
9955 for (x
= 0; x
< img
->width
; ++x
)
9957 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9958 lookup_pixel_color (f
, pixel
);
9961 /* Record colors in the image. Free color table and XImage. */
9962 img
->colors
= colors_in_color_table (&img
->ncolors
);
9963 free_color_table ();
9964 XDestroyImage (ximg
);
9966 #if 0 /* This doesn't seem to be the case. If we free the colors
9967 here, we get a BadAccess later in x_clear_image when
9968 freeing the colors. */
9969 /* We have allocated colors once, but Ghostscript has also
9970 allocated colors on behalf of us. So, to get the
9971 reference counts right, free them once. */
9973 x_free_colors (f
, img
->colors
, img
->ncolors
);
9977 image_error ("Cannot get X image of `%s'; colors will not be freed",
9986 /***********************************************************************
9988 ***********************************************************************/
9990 DEFUN ("x-change-window-property", Fx_change_window_property
,
9991 Sx_change_window_property
, 2, 3, 0,
9992 "Change window property PROP to VALUE on the X window of FRAME.\n\
9993 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9994 selected frame. Value is VALUE.")
9995 (prop
, value
, frame
)
9996 Lisp_Object frame
, prop
, value
;
9998 struct frame
*f
= check_x_frame (frame
);
10001 CHECK_STRING (prop
, 1);
10002 CHECK_STRING (value
, 2);
10005 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10006 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10007 prop_atom
, XA_STRING
, 8, PropModeReplace
,
10008 XSTRING (value
)->data
, XSTRING (value
)->size
);
10010 /* Make sure the property is set when we return. */
10011 XFlush (FRAME_X_DISPLAY (f
));
10018 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
10019 Sx_delete_window_property
, 1, 2, 0,
10020 "Remove window property PROP from X window of FRAME.\n\
10021 FRAME nil or omitted means use the selected frame. Value is PROP.")
10023 Lisp_Object prop
, frame
;
10025 struct frame
*f
= check_x_frame (frame
);
10028 CHECK_STRING (prop
, 1);
10030 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10031 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
10033 /* Make sure the property is removed when we return. */
10034 XFlush (FRAME_X_DISPLAY (f
));
10041 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
10043 "Value is the value of window property PROP on FRAME.\n\
10044 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10045 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10048 Lisp_Object prop
, frame
;
10050 struct frame
*f
= check_x_frame (frame
);
10053 Lisp_Object prop_value
= Qnil
;
10054 char *tmp_data
= NULL
;
10057 unsigned long actual_size
, bytes_remaining
;
10059 CHECK_STRING (prop
, 1);
10061 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
10062 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10063 prop_atom
, 0, 0, False
, XA_STRING
,
10064 &actual_type
, &actual_format
, &actual_size
,
10065 &bytes_remaining
, (unsigned char **) &tmp_data
);
10068 int size
= bytes_remaining
;
10073 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10074 prop_atom
, 0, bytes_remaining
,
10076 &actual_type
, &actual_format
,
10077 &actual_size
, &bytes_remaining
,
10078 (unsigned char **) &tmp_data
);
10080 prop_value
= make_string (tmp_data
, size
);
10091 /***********************************************************************
10093 ***********************************************************************/
10095 /* If non-null, an asynchronous timer that, when it expires, displays
10096 a busy cursor on all frames. */
10098 static struct atimer
*busy_cursor_atimer
;
10100 /* Non-zero means a busy cursor is currently shown. */
10102 static int busy_cursor_shown_p
;
10104 /* Number of seconds to wait before displaying a busy cursor. */
10106 static Lisp_Object Vbusy_cursor_delay
;
10108 /* Default number of seconds to wait before displaying a busy
10111 #define DEFAULT_BUSY_CURSOR_DELAY 1
10113 /* Function prototypes. */
10115 static void show_busy_cursor
P_ ((struct atimer
*));
10116 static void hide_busy_cursor
P_ ((void));
10119 /* Cancel a currently active busy-cursor timer, and start a new one. */
10122 start_busy_cursor ()
10125 int secs
, usecs
= 0;
10127 cancel_busy_cursor ();
10129 if (INTEGERP (Vbusy_cursor_delay
)
10130 && XINT (Vbusy_cursor_delay
) > 0)
10131 secs
= XFASTINT (Vbusy_cursor_delay
);
10132 else if (FLOATP (Vbusy_cursor_delay
)
10133 && XFLOAT_DATA (Vbusy_cursor_delay
) > 0)
10136 tem
= Ftruncate (Vbusy_cursor_delay
, Qnil
);
10137 secs
= XFASTINT (tem
);
10138 usecs
= (XFLOAT_DATA (Vbusy_cursor_delay
) - secs
) * 1000000;
10141 secs
= DEFAULT_BUSY_CURSOR_DELAY
;
10143 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
10144 busy_cursor_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
10145 show_busy_cursor
, NULL
);
10149 /* Cancel the busy cursor timer if active, hide a busy cursor if
10153 cancel_busy_cursor ()
10155 if (busy_cursor_atimer
)
10157 cancel_atimer (busy_cursor_atimer
);
10158 busy_cursor_atimer
= NULL
;
10161 if (busy_cursor_shown_p
)
10162 hide_busy_cursor ();
10166 /* Timer function of busy_cursor_atimer. TIMER is equal to
10167 busy_cursor_atimer.
10169 Display a busy cursor on all frames by mapping the frames'
10170 busy_window. Set the busy_p flag in the frames' output_data.x
10171 structure to indicate that a busy cursor is shown on the
10175 show_busy_cursor (timer
)
10176 struct atimer
*timer
;
10178 /* The timer implementation will cancel this timer automatically
10179 after this function has run. Set busy_cursor_atimer to null
10180 so that we know the timer doesn't have to be canceled. */
10181 busy_cursor_atimer
= NULL
;
10183 if (!busy_cursor_shown_p
)
10185 Lisp_Object rest
, frame
;
10189 FOR_EACH_FRAME (rest
, frame
)
10190 if (FRAME_X_P (XFRAME (frame
)))
10192 struct frame
*f
= XFRAME (frame
);
10194 f
->output_data
.x
->busy_p
= 1;
10196 if (!f
->output_data
.x
->busy_window
)
10198 unsigned long mask
= CWCursor
;
10199 XSetWindowAttributes attrs
;
10201 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
10203 f
->output_data
.x
->busy_window
10204 = XCreateWindow (FRAME_X_DISPLAY (f
),
10205 FRAME_OUTER_WINDOW (f
),
10206 0, 0, 32000, 32000, 0, 0,
10212 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10213 XFlush (FRAME_X_DISPLAY (f
));
10216 busy_cursor_shown_p
= 1;
10222 /* Hide the busy cursor on all frames, if it is currently shown. */
10225 hide_busy_cursor ()
10227 if (busy_cursor_shown_p
)
10229 Lisp_Object rest
, frame
;
10232 FOR_EACH_FRAME (rest
, frame
)
10234 struct frame
*f
= XFRAME (frame
);
10237 /* Watch out for newly created frames. */
10238 && f
->output_data
.x
->busy_window
)
10240 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
10241 /* Sync here because XTread_socket looks at the busy_p flag
10242 that is reset to zero below. */
10243 XSync (FRAME_X_DISPLAY (f
), False
);
10244 f
->output_data
.x
->busy_p
= 0;
10248 busy_cursor_shown_p
= 0;
10255 /***********************************************************************
10257 ***********************************************************************/
10259 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
10262 /* The frame of a currently visible tooltip, or null. */
10264 struct frame
*tip_frame
;
10266 /* If non-nil, a timer started that hides the last tooltip when it
10269 Lisp_Object tip_timer
;
10272 /* Create a frame for a tooltip on the display described by DPYINFO.
10273 PARMS is a list of frame parameters. Value is the frame. */
10276 x_create_tip_frame (dpyinfo
, parms
)
10277 struct x_display_info
*dpyinfo
;
10281 Lisp_Object frame
, tem
;
10283 long window_prompting
= 0;
10285 int count
= specpdl_ptr
- specpdl
;
10286 struct gcpro gcpro1
, gcpro2
, gcpro3
;
10291 /* Use this general default value to start with until we know if
10292 this frame has a specified name. */
10293 Vx_resource_name
= Vinvocation_name
;
10295 #ifdef MULTI_KBOARD
10296 kb
= dpyinfo
->kboard
;
10298 kb
= &the_only_kboard
;
10301 /* Get the name of the frame to use for resource lookup. */
10302 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
10303 if (!STRINGP (name
)
10304 && !EQ (name
, Qunbound
)
10306 error ("Invalid frame name--not a string or nil");
10307 Vx_resource_name
= name
;
10310 GCPRO3 (parms
, name
, frame
);
10311 tip_frame
= f
= make_frame (1);
10312 XSETFRAME (frame
, f
);
10313 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
10315 f
->output_method
= output_x_window
;
10316 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
10317 bzero (f
->output_data
.x
, sizeof (struct x_output
));
10318 f
->output_data
.x
->icon_bitmap
= -1;
10319 f
->output_data
.x
->fontset
= -1;
10320 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
10321 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
10322 f
->icon_name
= Qnil
;
10323 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
10324 #ifdef MULTI_KBOARD
10325 FRAME_KBOARD (f
) = kb
;
10327 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10328 f
->output_data
.x
->explicit_parent
= 0;
10330 /* These colors will be set anyway later, but it's important
10331 to get the color reference counts right, so initialize them! */
10334 struct gcpro gcpro1
;
10336 black
= build_string ("black");
10338 f
->output_data
.x
->foreground_pixel
10339 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10340 f
->output_data
.x
->background_pixel
10341 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10342 f
->output_data
.x
->cursor_pixel
10343 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10344 f
->output_data
.x
->cursor_foreground_pixel
10345 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10346 f
->output_data
.x
->border_pixel
10347 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10348 f
->output_data
.x
->mouse_pixel
10349 = x_decode_color (f
, black
, BLACK_PIX_DEFAULT (f
));
10353 /* Set the name; the functions to which we pass f expect the name to
10355 if (EQ (name
, Qunbound
) || NILP (name
))
10357 f
->name
= build_string (dpyinfo
->x_id_name
);
10358 f
->explicit_name
= 0;
10363 f
->explicit_name
= 1;
10364 /* use the frame's title when getting resources for this frame. */
10365 specbind (Qx_resource_name
, name
);
10368 /* Extract the window parameters from the supplied values
10369 that are needed to determine window geometry. */
10373 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10376 /* First, try whatever font the caller has specified. */
10377 if (STRINGP (font
))
10379 tem
= Fquery_fontset (font
, Qnil
);
10381 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10383 font
= x_new_font (f
, XSTRING (font
)->data
);
10386 /* Try out a font which we hope has bold and italic variations. */
10387 if (!STRINGP (font
))
10388 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10389 if (!STRINGP (font
))
10390 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10391 if (! STRINGP (font
))
10392 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10393 if (! STRINGP (font
))
10394 /* This was formerly the first thing tried, but it finds too many fonts
10395 and takes too long. */
10396 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10397 /* If those didn't work, look for something which will at least work. */
10398 if (! STRINGP (font
))
10399 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10401 if (! STRINGP (font
))
10402 font
= build_string ("fixed");
10404 x_default_parameter (f
, parms
, Qfont
, font
,
10405 "font", "Font", RES_TYPE_STRING
);
10408 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10409 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10411 /* This defaults to 2 in order to match xterm. We recognize either
10412 internalBorderWidth or internalBorder (which is what xterm calls
10414 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10418 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10419 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10420 if (! EQ (value
, Qunbound
))
10421 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10425 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10426 "internalBorderWidth", "internalBorderWidth",
10429 /* Also do the stuff which must be set before the window exists. */
10430 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10431 "foreground", "Foreground", RES_TYPE_STRING
);
10432 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10433 "background", "Background", RES_TYPE_STRING
);
10434 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10435 "pointerColor", "Foreground", RES_TYPE_STRING
);
10436 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10437 "cursorColor", "Foreground", RES_TYPE_STRING
);
10438 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10439 "borderColor", "BorderColor", RES_TYPE_STRING
);
10441 /* Init faces before x_default_parameter is called for scroll-bar
10442 parameters because that function calls x_set_scroll_bar_width,
10443 which calls change_frame_size, which calls Fset_window_buffer,
10444 which runs hooks, which call Fvertical_motion. At the end, we
10445 end up in init_iterator with a null face cache, which should not
10447 init_frame_faces (f
);
10449 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10450 window_prompting
= x_figure_window_size (f
, parms
);
10452 if (window_prompting
& XNegative
)
10454 if (window_prompting
& YNegative
)
10455 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10457 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10461 if (window_prompting
& YNegative
)
10462 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10464 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10467 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10469 XSetWindowAttributes attrs
;
10470 unsigned long mask
;
10473 mask
= CWBackPixel
| CWOverrideRedirect
| CWEventMask
;
10474 if (DoesSaveUnders (dpyinfo
->screen
))
10475 mask
|= CWSaveUnder
;
10477 /* Window managers look at the override-redirect flag to determine
10478 whether or net to give windows a decoration (Xlib spec, chapter
10480 attrs
.override_redirect
= True
;
10481 attrs
.save_under
= True
;
10482 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10483 /* Arrange for getting MapNotify and UnmapNotify events. */
10484 attrs
.event_mask
= StructureNotifyMask
;
10486 = FRAME_X_WINDOW (f
)
10487 = XCreateWindow (FRAME_X_DISPLAY (f
),
10488 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10489 /* x, y, width, height */
10493 CopyFromParent
, InputOutput
, CopyFromParent
,
10500 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10501 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10502 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10503 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10504 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10505 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10507 /* Dimensions, especially f->height, must be done via change_frame_size.
10508 Change will not be effected unless different from the current
10511 height
= f
->height
;
10513 SET_FRAME_WIDTH (f
, 0);
10514 change_frame_size (f
, height
, width
, 1, 0, 0);
10520 /* It is now ok to make the frame official even if we get an error
10521 below. And the frame needs to be on Vframe_list or making it
10522 visible won't work. */
10523 Vframe_list
= Fcons (frame
, Vframe_list
);
10525 /* Now that the frame is official, it counts as a reference to
10527 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10529 return unbind_to (count
, frame
);
10533 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
10534 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10535 A tooltip window is a small X window displaying a string.\n\
10537 FRAME nil or omitted means use the selected frame.\n\
10539 PARMS is an optional list of frame parameters which can be\n\
10540 used to change the tooltip's appearance.\n\
10542 Automatically hide the tooltip after TIMEOUT seconds.\n\
10543 TIMEOUT nil means use the default timeout of 5 seconds.\n\
10545 If the list of frame parameters PARAMS contains a `left' parameters,\n\
10546 the tooltip is displayed at that x-position. Otherwise it is\n\
10547 displayed at the mouse position, with offset DX added (default is 5 if\n\
10548 DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10549 parameter is specified, it determines the y-position of the tooltip\n\
10550 window, otherwise it is displayed at the mouse position, with offset\n\
10551 DY added (default is -10).")
10552 (string
, frame
, parms
, timeout
, dx
, dy
)
10553 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
10557 Window root
, child
;
10558 Lisp_Object buffer
, top
, left
;
10559 struct buffer
*old_buffer
;
10560 struct text_pos pos
;
10561 int i
, width
, height
;
10562 int root_x
, root_y
, win_x
, win_y
;
10564 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10565 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10566 int count
= specpdl_ptr
- specpdl
;
10568 specbind (Qinhibit_redisplay
, Qt
);
10570 GCPRO4 (string
, parms
, frame
, timeout
);
10572 CHECK_STRING (string
, 0);
10573 f
= check_x_frame (frame
);
10574 if (NILP (timeout
))
10575 timeout
= make_number (5);
10577 CHECK_NATNUM (timeout
, 2);
10580 dx
= make_number (5);
10582 CHECK_NUMBER (dx
, 5);
10585 dy
= make_number (-10);
10587 CHECK_NUMBER (dy
, 6);
10589 /* Hide a previous tip, if any. */
10592 /* Add default values to frame parameters. */
10593 if (NILP (Fassq (Qname
, parms
)))
10594 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10595 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10596 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10597 if (NILP (Fassq (Qborder_width
, parms
)))
10598 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10599 if (NILP (Fassq (Qborder_color
, parms
)))
10600 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10601 if (NILP (Fassq (Qbackground_color
, parms
)))
10602 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10605 /* Create a frame for the tooltip, and record it in the global
10606 variable tip_frame. */
10607 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10608 tip_frame
= f
= XFRAME (frame
);
10610 /* Set up the frame's root window. Currently we use a size of 80
10611 columns x 40 lines. If someone wants to show a larger tip, he
10612 will loose. I don't think this is a realistic case. */
10613 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10614 w
->left
= w
->top
= make_number (0);
10615 w
->width
= make_number (80);
10616 w
->height
= make_number (40);
10618 w
->pseudo_window_p
= 1;
10620 /* Display the tooltip text in a temporary buffer. */
10621 buffer
= Fget_buffer_create (build_string (" *tip*"));
10622 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10623 old_buffer
= current_buffer
;
10624 set_buffer_internal_1 (XBUFFER (buffer
));
10626 Finsert (1, &string
);
10627 clear_glyph_matrix (w
->desired_matrix
);
10628 clear_glyph_matrix (w
->current_matrix
);
10629 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10630 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10632 /* Compute width and height of the tooltip. */
10633 width
= height
= 0;
10634 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10636 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10637 struct glyph
*last
;
10640 /* Stop at the first empty row at the end. */
10641 if (!row
->enabled_p
|| !row
->displays_text_p
)
10644 /* Let the row go over the full width of the frame. */
10645 row
->full_width_p
= 1;
10647 /* There's a glyph at the end of rows that is used to place
10648 the cursor there. Don't include the width of this glyph. */
10649 if (row
->used
[TEXT_AREA
])
10651 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10652 row_width
= row
->pixel_width
- last
->pixel_width
;
10655 row_width
= row
->pixel_width
;
10657 height
+= row
->height
;
10658 width
= max (width
, row_width
);
10661 /* Add the frame's internal border to the width and height the X
10662 window should have. */
10663 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10664 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10666 /* User-specified position? */
10667 left
= Fcdr (Fassq (Qleft
, parms
));
10668 top
= Fcdr (Fassq (Qtop
, parms
));
10670 /* Move the tooltip window where the mouse pointer is. Resize and
10673 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10674 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10677 root_x
+= XINT (dx
);
10678 root_y
+= XINT (dy
);
10680 if (INTEGERP (left
))
10681 root_x
= XINT (left
);
10682 if (INTEGERP (top
))
10683 root_y
= XINT (top
);
10686 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10687 root_x
, root_y
- height
, width
, height
);
10688 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10691 /* Draw into the window. */
10692 w
->must_be_updated_p
= 1;
10693 update_single_window (w
, 1);
10695 /* Restore original current buffer. */
10696 set_buffer_internal_1 (old_buffer
);
10697 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10699 /* Let the tip disappear after timeout seconds. */
10700 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10701 intern ("x-hide-tip"));
10704 return unbind_to (count
, Qnil
);
10708 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10709 "Hide the current tooltip window, if there is any.\n\
10710 Value is t is tooltip was open, nil otherwise.")
10713 int count
= specpdl_ptr
- specpdl
;
10716 specbind (Qinhibit_redisplay
, Qt
);
10718 if (!NILP (tip_timer
))
10720 call1 (intern ("cancel-timer"), tip_timer
);
10728 XSETFRAME (frame
, tip_frame
);
10729 Fdelete_frame (frame
, Qt
);
10734 /* Bloodcurdling hack alert: The Lucid menu bar widget's
10735 redisplay procedure is not called when a tip frame over menu
10736 items is unmapped. Redisplay the menu manually... */
10738 struct frame
*f
= SELECTED_FRAME ();
10739 Widget w
= f
->output_data
.x
->menubar_widget
;
10740 extern void xlwmenu_redisplay
P_ ((Widget
));
10742 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f
)->screen
)
10746 xlwmenu_redisplay (w
);
10750 #endif /* USE_LUCID */
10753 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10758 /***********************************************************************
10759 File selection dialog
10760 ***********************************************************************/
10764 /* Callback for "OK" and "Cancel" on file selection dialog. */
10767 file_dialog_cb (widget
, client_data
, call_data
)
10769 XtPointer call_data
, client_data
;
10771 int *result
= (int *) client_data
;
10772 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10773 *result
= cb
->reason
;
10777 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10778 "Read file name, prompting with PROMPT in directory DIR.\n\
10779 Use a file selection dialog.\n\
10780 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10781 specified. Don't let the user enter a file name in the file\n\
10782 selection dialog's entry field, if MUSTMATCH is non-nil.")
10783 (prompt
, dir
, default_filename
, mustmatch
)
10784 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10787 struct frame
*f
= SELECTED_FRAME ();
10788 Lisp_Object file
= Qnil
;
10789 Widget dialog
, text
, list
, help
;
10792 extern XtAppContext Xt_app_con
;
10794 XmString dir_xmstring
, pattern_xmstring
;
10795 int popup_activated_flag
;
10796 int count
= specpdl_ptr
- specpdl
;
10797 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10799 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10800 CHECK_STRING (prompt
, 0);
10801 CHECK_STRING (dir
, 1);
10803 /* Prevent redisplay. */
10804 specbind (Qinhibit_redisplay
, Qt
);
10808 /* Create the dialog with PROMPT as title, using DIR as initial
10809 directory and using "*" as pattern. */
10810 dir
= Fexpand_file_name (dir
, Qnil
);
10811 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10812 pattern_xmstring
= XmStringCreateLocalized ("*");
10814 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10815 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10816 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10817 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10818 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10819 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10821 XmStringFree (dir_xmstring
);
10822 XmStringFree (pattern_xmstring
);
10824 /* Add callbacks for OK and Cancel. */
10825 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10826 (XtPointer
) &result
);
10827 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10828 (XtPointer
) &result
);
10830 /* Disable the help button since we can't display help. */
10831 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10832 XtSetSensitive (help
, False
);
10834 /* Mark OK button as default. */
10835 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10836 XmNshowAsDefault
, True
, NULL
);
10838 /* If MUSTMATCH is non-nil, disable the file entry field of the
10839 dialog, so that the user must select a file from the files list
10840 box. We can't remove it because we wouldn't have a way to get at
10841 the result file name, then. */
10842 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10843 if (!NILP (mustmatch
))
10846 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10847 XtSetSensitive (text
, False
);
10848 XtSetSensitive (label
, False
);
10851 /* Manage the dialog, so that list boxes get filled. */
10852 XtManageChild (dialog
);
10854 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10855 must include the path for this to work. */
10856 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10857 if (STRINGP (default_filename
))
10859 XmString default_xmstring
;
10863 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10865 if (!XmListItemExists (list
, default_xmstring
))
10867 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10868 XmListAddItem (list
, default_xmstring
, 0);
10872 item_pos
= XmListItemPos (list
, default_xmstring
);
10873 XmStringFree (default_xmstring
);
10875 /* Select the item and scroll it into view. */
10876 XmListSelectPos (list
, item_pos
, True
);
10877 XmListSetPos (list
, item_pos
);
10880 #ifdef HAVE_MOTIF_2_1
10882 /* Process events until the user presses Cancel or OK. */
10884 while (result
== 0 || XtAppPending (Xt_app_con
))
10885 XtAppProcessEvent (Xt_app_con
, XtIMAll
);
10887 #else /* not HAVE_MOTIF_2_1 */
10889 /* Process all events until the user presses Cancel or OK. */
10890 for (result
= 0; result
== 0;)
10893 Widget widget
, parent
;
10895 XtAppNextEvent (Xt_app_con
, &event
);
10897 /* See if the receiver of the event is one of the widgets of
10898 the file selection dialog. If so, dispatch it. If not,
10900 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10902 while (parent
&& parent
!= dialog
)
10903 parent
= XtParent (parent
);
10905 if (parent
== dialog
10906 || (event
.type
== Expose
10907 && !process_expose_from_menu (event
)))
10908 XtDispatchEvent (&event
);
10911 #endif /* not HAVE_MOTIF_2_1 */
10913 /* Get the result. */
10914 if (result
== XmCR_OK
)
10919 XtVaGetValues (dialog
, XmNtextString
, &text
, NULL
);
10920 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10921 XmStringFree (text
);
10922 file
= build_string (data
);
10929 XtUnmanageChild (dialog
);
10930 XtDestroyWidget (dialog
);
10934 /* Make "Cancel" equivalent to C-g. */
10936 Fsignal (Qquit
, Qnil
);
10938 return unbind_to (count
, file
);
10941 #endif /* USE_MOTIF */
10945 /***********************************************************************
10947 ***********************************************************************/
10952 /* This is zero if not using X windows. */
10955 /* The section below is built by the lisp expression at the top of the file,
10956 just above where these variables are declared. */
10957 /*&&& init symbols here &&&*/
10958 Qauto_raise
= intern ("auto-raise");
10959 staticpro (&Qauto_raise
);
10960 Qauto_lower
= intern ("auto-lower");
10961 staticpro (&Qauto_lower
);
10962 Qbar
= intern ("bar");
10964 Qborder_color
= intern ("border-color");
10965 staticpro (&Qborder_color
);
10966 Qborder_width
= intern ("border-width");
10967 staticpro (&Qborder_width
);
10968 Qbox
= intern ("box");
10970 Qcursor_color
= intern ("cursor-color");
10971 staticpro (&Qcursor_color
);
10972 Qcursor_type
= intern ("cursor-type");
10973 staticpro (&Qcursor_type
);
10974 Qgeometry
= intern ("geometry");
10975 staticpro (&Qgeometry
);
10976 Qicon_left
= intern ("icon-left");
10977 staticpro (&Qicon_left
);
10978 Qicon_top
= intern ("icon-top");
10979 staticpro (&Qicon_top
);
10980 Qicon_type
= intern ("icon-type");
10981 staticpro (&Qicon_type
);
10982 Qicon_name
= intern ("icon-name");
10983 staticpro (&Qicon_name
);
10984 Qinternal_border_width
= intern ("internal-border-width");
10985 staticpro (&Qinternal_border_width
);
10986 Qleft
= intern ("left");
10987 staticpro (&Qleft
);
10988 Qright
= intern ("right");
10989 staticpro (&Qright
);
10990 Qmouse_color
= intern ("mouse-color");
10991 staticpro (&Qmouse_color
);
10992 Qnone
= intern ("none");
10993 staticpro (&Qnone
);
10994 Qparent_id
= intern ("parent-id");
10995 staticpro (&Qparent_id
);
10996 Qscroll_bar_width
= intern ("scroll-bar-width");
10997 staticpro (&Qscroll_bar_width
);
10998 Qsuppress_icon
= intern ("suppress-icon");
10999 staticpro (&Qsuppress_icon
);
11000 Qundefined_color
= intern ("undefined-color");
11001 staticpro (&Qundefined_color
);
11002 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
11003 staticpro (&Qvertical_scroll_bars
);
11004 Qvisibility
= intern ("visibility");
11005 staticpro (&Qvisibility
);
11006 Qwindow_id
= intern ("window-id");
11007 staticpro (&Qwindow_id
);
11008 Qouter_window_id
= intern ("outer-window-id");
11009 staticpro (&Qouter_window_id
);
11010 Qx_frame_parameter
= intern ("x-frame-parameter");
11011 staticpro (&Qx_frame_parameter
);
11012 Qx_resource_name
= intern ("x-resource-name");
11013 staticpro (&Qx_resource_name
);
11014 Quser_position
= intern ("user-position");
11015 staticpro (&Quser_position
);
11016 Quser_size
= intern ("user-size");
11017 staticpro (&Quser_size
);
11018 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
11019 staticpro (&Qscroll_bar_foreground
);
11020 Qscroll_bar_background
= intern ("scroll-bar-background");
11021 staticpro (&Qscroll_bar_background
);
11022 Qscreen_gamma
= intern ("screen-gamma");
11023 staticpro (&Qscreen_gamma
);
11024 Qline_spacing
= intern ("line-spacing");
11025 staticpro (&Qline_spacing
);
11026 Qcenter
= intern ("center");
11027 staticpro (&Qcenter
);
11028 Qcompound_text
= intern ("compound-text");
11029 staticpro (&Qcompound_text
);
11030 /* This is the end of symbol initialization. */
11032 /* Text property `display' should be nonsticky by default. */
11033 Vtext_property_default_nonsticky
11034 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
11037 Qlaplace
= intern ("laplace");
11038 staticpro (&Qlaplace
);
11039 Qemboss
= intern ("emboss");
11040 staticpro (&Qemboss
);
11041 Qedge_detection
= intern ("edge-detection");
11042 staticpro (&Qedge_detection
);
11043 Qheuristic
= intern ("heuristic");
11044 staticpro (&Qheuristic
);
11045 QCmatrix
= intern (":matrix");
11046 staticpro (&QCmatrix
);
11047 QCcolor_adjustment
= intern (":color-adjustment");
11048 staticpro (&QCcolor_adjustment
);
11049 QCmask
= intern (":mask");
11050 staticpro (&QCmask
);
11052 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
11053 staticpro (&Qface_set_after_frame_default
);
11055 Fput (Qundefined_color
, Qerror_conditions
,
11056 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
11057 Fput (Qundefined_color
, Qerror_message
,
11058 build_string ("Undefined color"));
11060 init_x_parm_symbols ();
11062 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images
,
11063 "Non-nil means always draw a cross over disabled images.\n\
11064 Disabled images are those having an `:algorithm disabled' property.\n\
11065 A cross is always drawn on black & white displays.");
11066 cross_disabled_images
= 0;
11068 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
11069 "List of directories to search for bitmap files for X.");
11070 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
11072 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
11073 "The shape of the pointer when over text.\n\
11074 Changing the value does not affect existing frames\n\
11075 unless you set the mouse color.");
11076 Vx_pointer_shape
= Qnil
;
11078 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
11079 "The name Emacs uses to look up X resources.\n\
11080 `x-get-resource' uses this as the first component of the instance name\n\
11081 when requesting resource values.\n\
11082 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11083 was invoked, or to the value specified with the `-name' or `-rn'\n\
11084 switches, if present.\n\
11086 It may be useful to bind this variable locally around a call\n\
11087 to `x-get-resource'. See also the variable `x-resource-class'.");
11088 Vx_resource_name
= Qnil
;
11090 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
11091 "The class Emacs uses to look up X resources.\n\
11092 `x-get-resource' uses this as the first component of the instance class\n\
11093 when requesting resource values.\n\
11094 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11096 Setting this variable permanently is not a reasonable thing to do,\n\
11097 but binding this variable locally around a call to `x-get-resource'\n\
11098 is a reasonable practice. See also the variable `x-resource-name'.");
11099 Vx_resource_class
= build_string (EMACS_CLASS
);
11101 #if 0 /* This doesn't really do anything. */
11102 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
11103 "The shape of the pointer when not over text.\n\
11104 This variable takes effect when you create a new frame\n\
11105 or when you set the mouse color.");
11107 Vx_nontext_pointer_shape
= Qnil
;
11109 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
11110 "The shape of the pointer when Emacs is busy.\n\
11111 This variable takes effect when you create a new frame\n\
11112 or when you set the mouse color.");
11113 Vx_busy_pointer_shape
= Qnil
;
11115 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
11116 "Non-zero means Emacs displays a busy cursor on window systems.");
11117 display_busy_cursor_p
= 1;
11119 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay
,
11120 "*Seconds to wait before displaying a busy-cursor.\n\
11121 Value must be an integer or float.");
11122 Vbusy_cursor_delay
= make_number (DEFAULT_BUSY_CURSOR_DELAY
);
11124 #if 0 /* This doesn't really do anything. */
11125 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
11126 "The shape of the pointer when over the mode line.\n\
11127 This variable takes effect when you create a new frame\n\
11128 or when you set the mouse color.");
11130 Vx_mode_pointer_shape
= Qnil
;
11132 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11133 &Vx_sensitive_text_pointer_shape
,
11134 "The shape of the pointer when over mouse-sensitive text.\n\
11135 This variable takes effect when you create a new frame\n\
11136 or when you set the mouse color.");
11137 Vx_sensitive_text_pointer_shape
= Qnil
;
11139 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11140 &Vx_window_horizontal_drag_shape
,
11141 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11142 This variable takes effect when you create a new frame\n\
11143 or when you set the mouse color.");
11144 Vx_window_horizontal_drag_shape
= Qnil
;
11146 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
11147 "A string indicating the foreground color of the cursor box.");
11148 Vx_cursor_fore_pixel
= Qnil
;
11150 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
11151 "Non-nil if no X window manager is in use.\n\
11152 Emacs doesn't try to figure this out; this is always nil\n\
11153 unless you set it to something else.");
11154 /* We don't have any way to find this out, so set it to nil
11155 and maybe the user would like to set it to t. */
11156 Vx_no_window_manager
= Qnil
;
11158 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11159 &Vx_pixel_size_width_font_regexp
,
11160 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11162 Since Emacs gets width of a font matching with this regexp from\n\
11163 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11164 such a font. This is especially effective for such large fonts as\n\
11165 Chinese, Japanese, and Korean.");
11166 Vx_pixel_size_width_font_regexp
= Qnil
;
11168 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
11169 "Time after which cached images are removed from the cache.\n\
11170 When an image has not been displayed this many seconds, remove it\n\
11171 from the image cache. Value must be an integer or nil with nil\n\
11172 meaning don't clear the cache.");
11173 Vimage_cache_eviction_delay
= make_number (30 * 60);
11175 #ifdef USE_X_TOOLKIT
11176 Fprovide (intern ("x-toolkit"));
11179 Fprovide (intern ("motif"));
11182 defsubr (&Sx_get_resource
);
11184 /* X window properties. */
11185 defsubr (&Sx_change_window_property
);
11186 defsubr (&Sx_delete_window_property
);
11187 defsubr (&Sx_window_property
);
11189 defsubr (&Sxw_display_color_p
);
11190 defsubr (&Sx_display_grayscale_p
);
11191 defsubr (&Sxw_color_defined_p
);
11192 defsubr (&Sxw_color_values
);
11193 defsubr (&Sx_server_max_request_size
);
11194 defsubr (&Sx_server_vendor
);
11195 defsubr (&Sx_server_version
);
11196 defsubr (&Sx_display_pixel_width
);
11197 defsubr (&Sx_display_pixel_height
);
11198 defsubr (&Sx_display_mm_width
);
11199 defsubr (&Sx_display_mm_height
);
11200 defsubr (&Sx_display_screens
);
11201 defsubr (&Sx_display_planes
);
11202 defsubr (&Sx_display_color_cells
);
11203 defsubr (&Sx_display_visual_class
);
11204 defsubr (&Sx_display_backing_store
);
11205 defsubr (&Sx_display_save_under
);
11206 defsubr (&Sx_parse_geometry
);
11207 defsubr (&Sx_create_frame
);
11208 defsubr (&Sx_open_connection
);
11209 defsubr (&Sx_close_connection
);
11210 defsubr (&Sx_display_list
);
11211 defsubr (&Sx_synchronize
);
11212 defsubr (&Sx_focus_frame
);
11214 /* Setting callback functions for fontset handler. */
11215 get_font_info_func
= x_get_font_info
;
11217 #if 0 /* This function pointer doesn't seem to be used anywhere.
11218 And the pointer assigned has the wrong type, anyway. */
11219 list_fonts_func
= x_list_fonts
;
11222 load_font_func
= x_load_font
;
11223 find_ccl_program_func
= x_find_ccl_program
;
11224 query_font_func
= x_query_font
;
11225 set_frame_fontset_func
= x_set_font
;
11226 check_window_system_func
= check_x
;
11229 Qxbm
= intern ("xbm");
11231 QCtype
= intern (":type");
11232 staticpro (&QCtype
);
11233 QCalgorithm
= intern (":algorithm");
11234 staticpro (&QCalgorithm
);
11235 QCheuristic_mask
= intern (":heuristic-mask");
11236 staticpro (&QCheuristic_mask
);
11237 QCcolor_symbols
= intern (":color-symbols");
11238 staticpro (&QCcolor_symbols
);
11239 QCascent
= intern (":ascent");
11240 staticpro (&QCascent
);
11241 QCmargin
= intern (":margin");
11242 staticpro (&QCmargin
);
11243 QCrelief
= intern (":relief");
11244 staticpro (&QCrelief
);
11245 Qpostscript
= intern ("postscript");
11246 staticpro (&Qpostscript
);
11247 QCloader
= intern (":loader");
11248 staticpro (&QCloader
);
11249 QCbounding_box
= intern (":bounding-box");
11250 staticpro (&QCbounding_box
);
11251 QCpt_width
= intern (":pt-width");
11252 staticpro (&QCpt_width
);
11253 QCpt_height
= intern (":pt-height");
11254 staticpro (&QCpt_height
);
11255 QCindex
= intern (":index");
11256 staticpro (&QCindex
);
11257 Qpbm
= intern ("pbm");
11261 Qxpm
= intern ("xpm");
11266 Qjpeg
= intern ("jpeg");
11267 staticpro (&Qjpeg
);
11271 Qtiff
= intern ("tiff");
11272 staticpro (&Qtiff
);
11276 Qgif
= intern ("gif");
11281 Qpng
= intern ("png");
11285 defsubr (&Sclear_image_cache
);
11286 defsubr (&Simage_size
);
11287 defsubr (&Simage_mask_p
);
11289 busy_cursor_atimer
= NULL
;
11290 busy_cursor_shown_p
= 0;
11292 defsubr (&Sx_show_tip
);
11293 defsubr (&Sx_hide_tip
);
11294 staticpro (&tip_timer
);
11298 defsubr (&Sx_file_dialog
);
11306 image_types
= NULL
;
11307 Vimage_types
= Qnil
;
11309 define_image_type (&xbm_type
);
11310 define_image_type (&gs_type
);
11311 define_image_type (&pbm_type
);
11314 define_image_type (&xpm_type
);
11318 define_image_type (&jpeg_type
);
11322 define_image_type (&tiff_type
);
11326 define_image_type (&gif_type
);
11330 define_image_type (&png_type
);
11334 #endif /* HAVE_X_WINDOWS */