1 /* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999
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. */
22 /* Image support (XBM, XPM, PBM, JPEG, TIFF, GIF, PNG, GS). tooltips,
23 tool-bars, busy-cursor, file selection dialog added by Gerd
24 Moellmann <gerd@gnu.org>. */
26 /* Completely rewritten by Richard Stallman. */
28 /* Rewritten for X11 by Joseph Arceneaux */
35 /* This makes the fields of a Display accessible, in Xlib header files. */
37 #define XLIB_ILLEGAL_ACCESS
44 #include "dispextern.h"
46 #include "blockinput.h"
51 #include "termhooks.h"
62 /* On some systems, the character-composition stuff is broken in X11R5. */
64 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
65 #ifdef X11R5_INHIBIT_I18N
66 #define X_I18N_INHIBITED
71 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
72 #include "bitmaps/gray.xbm"
74 #include <X11/bitmaps/gray>
77 #include "[.bitmaps]gray.xbm"
81 #include <X11/Shell.h>
84 #include <X11/Xaw/Paned.h>
85 #include <X11/Xaw/Label.h>
86 #endif /* USE_MOTIF */
89 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
98 #include "../lwlib/lwlib.h"
102 #include <Xm/DialogS.h>
103 #include <Xm/FileSB.h>
106 /* Do the EDITRES protocol if running X11R5
107 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
109 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
111 extern void _XEditResCheckMessages ();
112 #endif /* R5 + Athena */
114 /* Unique id counter for widgets created by the Lucid Widget Library. */
116 extern LWLIB_ID widget_id_tick
;
119 /* This is part of a kludge--see lwlib/xlwmenu.c. */
120 extern XFontStruct
*xlwmenu_default_font
;
123 extern void free_frame_menubar ();
124 extern double atof ();
126 #endif /* USE_X_TOOLKIT */
128 #define min(a,b) ((a) < (b) ? (a) : (b))
129 #define max(a,b) ((a) > (b) ? (a) : (b))
132 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
134 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
137 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
138 it, and including `bitmaps/gray' more than once is a problem when
139 config.h defines `static' as an empty replacement string. */
141 int gray_bitmap_width
= gray_width
;
142 int gray_bitmap_height
= gray_height
;
143 unsigned char *gray_bitmap_bits
= gray_bits
;
145 /* The name we're using in resource queries. Most often "emacs". */
147 Lisp_Object Vx_resource_name
;
149 /* The application class we're using in resource queries.
152 Lisp_Object Vx_resource_class
;
154 /* Non-zero means we're allowed to display a busy cursor. */
156 int display_busy_cursor_p
;
158 /* The background and shape of the mouse pointer, and shape when not
159 over text or in the modeline. */
161 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
162 Lisp_Object Vx_busy_pointer_shape
;
164 /* The shape when over mouse-sensitive text. */
166 Lisp_Object Vx_sensitive_text_pointer_shape
;
168 /* Color of chars displayed in cursor box. */
170 Lisp_Object Vx_cursor_fore_pixel
;
172 /* Nonzero if using X. */
176 /* Non nil if no window manager is in use. */
178 Lisp_Object Vx_no_window_manager
;
180 /* Search path for bitmap files. */
182 Lisp_Object Vx_bitmap_file_path
;
184 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
186 Lisp_Object Vx_pixel_size_width_font_regexp
;
188 /* Evaluate this expression to rebuild the section of syms_of_xfns
189 that initializes and staticpros the symbols declared below. Note
190 that Emacs 18 has a bug that keeps C-x C-e from being able to
191 evaluate this expression.
194 ;; Accumulate a list of the symbols we want to initialize from the
195 ;; declarations at the top of the file.
196 (goto-char (point-min))
197 (search-forward "/\*&&& symbols declared here &&&*\/\n")
199 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
201 (cons (buffer-substring (match-beginning 1) (match-end 1))
204 (setq symbol-list (nreverse symbol-list))
205 ;; Delete the section of syms_of_... where we initialize the symbols.
206 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
207 (let ((start (point)))
208 (while (looking-at "^ Q")
210 (kill-region start (point)))
211 ;; Write a new symbol initialization section.
213 (insert (format " %s = intern (\"" (car symbol-list)))
214 (let ((start (point)))
215 (insert (substring (car symbol-list) 1))
216 (subst-char-in-region start (point) ?_ ?-))
217 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
218 (setq symbol-list (cdr symbol-list)))))
222 /*&&& symbols declared here &&&*/
223 Lisp_Object Qauto_raise
;
224 Lisp_Object Qauto_lower
;
226 Lisp_Object Qborder_color
;
227 Lisp_Object Qborder_width
;
229 Lisp_Object Qcursor_color
;
230 Lisp_Object Qcursor_type
;
231 Lisp_Object Qgeometry
;
232 Lisp_Object Qicon_left
;
233 Lisp_Object Qicon_top
;
234 Lisp_Object Qicon_type
;
235 Lisp_Object Qicon_name
;
236 Lisp_Object Qinternal_border_width
;
239 Lisp_Object Qmouse_color
;
241 Lisp_Object Qouter_window_id
;
242 Lisp_Object Qparent_id
;
243 Lisp_Object Qscroll_bar_width
;
244 Lisp_Object Qsuppress_icon
;
245 extern Lisp_Object Qtop
;
246 Lisp_Object Qundefined_color
;
247 Lisp_Object Qvertical_scroll_bars
;
248 Lisp_Object Qvisibility
;
249 Lisp_Object Qwindow_id
;
250 Lisp_Object Qx_frame_parameter
;
251 Lisp_Object Qx_resource_name
;
252 Lisp_Object Quser_position
;
253 Lisp_Object Quser_size
;
254 Lisp_Object Qdisplay
;
255 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
256 Lisp_Object Qscreen_gamma
;
258 /* The below are defined in frame.c. */
260 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
261 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
262 extern Lisp_Object Qtool_bar_lines
;
264 extern Lisp_Object Vwindow_system_version
;
266 Lisp_Object Qface_set_after_frame_default
;
269 /* Error if we are not connected to X. */
275 error ("X windows are not in use or not initialized");
278 /* Nonzero if we can use mouse menus.
279 You should not call this unless HAVE_MENUS is defined. */
287 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
288 and checking validity for X. */
291 check_x_frame (frame
)
297 frame
= selected_frame
;
298 CHECK_LIVE_FRAME (frame
, 0);
301 error ("Non-X frame used");
305 /* Let the user specify an X display with a frame.
306 nil stands for the selected frame--or, if that is not an X frame,
307 the first X display on the list. */
309 static struct x_display_info
*
310 check_x_display_info (frame
)
315 struct frame
*sf
= XFRAME (selected_frame
);
317 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
318 return FRAME_X_DISPLAY_INFO (sf
);
319 else if (x_display_list
!= 0)
320 return x_display_list
;
322 error ("X windows are not in use or not initialized");
324 else if (STRINGP (frame
))
325 return x_display_info_for_name (frame
);
330 CHECK_LIVE_FRAME (frame
, 0);
333 error ("Non-X frame used");
334 return FRAME_X_DISPLAY_INFO (f
);
339 /* Return the Emacs frame-object corresponding to an X window.
340 It could be the frame's main window or an icon window. */
342 /* This function can be called during GC, so use GC_xxx type test macros. */
345 x_window_to_frame (dpyinfo
, wdesc
)
346 struct x_display_info
*dpyinfo
;
349 Lisp_Object tail
, frame
;
352 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
355 if (!GC_FRAMEP (frame
))
358 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
361 if ((f
->output_data
.x
->edit_widget
362 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
363 /* A tooltip frame? */
364 || (!f
->output_data
.x
->edit_widget
365 && FRAME_X_WINDOW (f
) == wdesc
)
366 || f
->output_data
.x
->icon_desc
== wdesc
)
368 #else /* not USE_X_TOOLKIT */
369 if (FRAME_X_WINDOW (f
) == wdesc
370 || f
->output_data
.x
->icon_desc
== wdesc
)
372 #endif /* not USE_X_TOOLKIT */
378 /* Like x_window_to_frame but also compares the window with the widget's
382 x_any_window_to_frame (dpyinfo
, wdesc
)
383 struct x_display_info
*dpyinfo
;
386 Lisp_Object tail
, frame
;
390 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
393 if (!GC_FRAMEP (frame
))
396 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
398 x
= f
->output_data
.x
;
399 /* This frame matches if the window is any of its widgets. */
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 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
410 else if (FRAME_X_WINDOW (f
) == wdesc
)
411 /* A tooltip frame. */
417 /* Likewise, but exclude the menu bar widget. */
420 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
421 struct x_display_info
*dpyinfo
;
424 Lisp_Object tail
, frame
;
428 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
431 if (!GC_FRAMEP (frame
))
434 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
436 x
= f
->output_data
.x
;
437 /* This frame matches if the window is any of its widgets. */
440 if (wdesc
== XtWindow (x
->widget
)
441 || wdesc
== XtWindow (x
->column_widget
)
442 || wdesc
== XtWindow (x
->edit_widget
))
445 else if (FRAME_X_WINDOW (f
) == wdesc
)
446 /* A tooltip frame. */
452 /* Likewise, but consider only the menu bar widget. */
455 x_menubar_window_to_frame (dpyinfo
, wdesc
)
456 struct x_display_info
*dpyinfo
;
459 Lisp_Object tail
, frame
;
463 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
466 if (!GC_FRAMEP (frame
))
469 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
471 x
= f
->output_data
.x
;
472 /* Match if the window is this frame's menubar. */
473 if (x
->menubar_widget
474 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
480 /* Return the frame whose principal (outermost) window is WDESC.
481 If WDESC is some other (smaller) window, we return 0. */
484 x_top_window_to_frame (dpyinfo
, wdesc
)
485 struct x_display_info
*dpyinfo
;
488 Lisp_Object tail
, frame
;
492 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
495 if (!GC_FRAMEP (frame
))
498 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
500 x
= f
->output_data
.x
;
504 /* This frame matches if the window is its topmost widget. */
505 if (wdesc
== XtWindow (x
->widget
))
507 #if 0 /* I don't know why it did this,
508 but it seems logically wrong,
509 and it causes trouble for MapNotify events. */
510 /* Match if the window is this frame's menubar. */
511 if (x
->menubar_widget
512 && wdesc
== XtWindow (x
->menubar_widget
))
516 else if (FRAME_X_WINDOW (f
) == wdesc
)
522 #endif /* USE_X_TOOLKIT */
526 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
527 id, which is just an int that this section returns. Bitmaps are
528 reference counted so they can be shared among frames.
530 Bitmap indices are guaranteed to be > 0, so a negative number can
531 be used to indicate no bitmap.
533 If you use x_create_bitmap_from_data, then you must keep track of
534 the bitmaps yourself. That is, creating a bitmap from the same
535 data more than once will not be caught. */
538 /* Functions to access the contents of a bitmap, given an id. */
541 x_bitmap_height (f
, id
)
545 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
549 x_bitmap_width (f
, id
)
553 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
557 x_bitmap_pixmap (f
, id
)
561 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
565 /* Allocate a new bitmap record. Returns index of new record. */
568 x_allocate_bitmap_record (f
)
571 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
574 if (dpyinfo
->bitmaps
== NULL
)
576 dpyinfo
->bitmaps_size
= 10;
578 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
579 dpyinfo
->bitmaps_last
= 1;
583 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
584 return ++dpyinfo
->bitmaps_last
;
586 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
587 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
590 dpyinfo
->bitmaps_size
*= 2;
592 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
593 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
594 return ++dpyinfo
->bitmaps_last
;
597 /* Add one reference to the reference count of the bitmap with id ID. */
600 x_reference_bitmap (f
, id
)
604 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
607 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
610 x_create_bitmap_from_data (f
, bits
, width
, height
)
613 unsigned int width
, height
;
615 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
619 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
620 bits
, width
, height
);
625 id
= x_allocate_bitmap_record (f
);
626 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
627 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
628 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
629 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
630 dpyinfo
->bitmaps
[id
- 1].height
= height
;
631 dpyinfo
->bitmaps
[id
- 1].width
= width
;
636 /* Create bitmap from file FILE for frame F. */
639 x_create_bitmap_from_file (f
, file
)
643 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
644 unsigned int width
, height
;
646 int xhot
, yhot
, result
, id
;
651 /* Look for an existing bitmap with the same name. */
652 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
654 if (dpyinfo
->bitmaps
[id
].refcount
655 && dpyinfo
->bitmaps
[id
].file
656 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
658 ++dpyinfo
->bitmaps
[id
].refcount
;
663 /* Search bitmap-file-path for the file, if appropriate. */
664 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
667 /* XReadBitmapFile won't handle magic file names. */
672 filename
= (char *) XSTRING (found
)->data
;
674 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
675 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
676 if (result
!= BitmapSuccess
)
679 id
= x_allocate_bitmap_record (f
);
680 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
681 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
682 dpyinfo
->bitmaps
[id
- 1].file
683 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
684 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
685 dpyinfo
->bitmaps
[id
- 1].height
= height
;
686 dpyinfo
->bitmaps
[id
- 1].width
= width
;
687 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
692 /* Remove reference to bitmap with id number ID. */
695 x_destroy_bitmap (f
, id
)
699 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
703 --dpyinfo
->bitmaps
[id
- 1].refcount
;
704 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
707 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
708 if (dpyinfo
->bitmaps
[id
- 1].file
)
710 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
711 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
718 /* Free all the bitmaps for the display specified by DPYINFO. */
721 x_destroy_all_bitmaps (dpyinfo
)
722 struct x_display_info
*dpyinfo
;
725 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
726 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
728 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
729 if (dpyinfo
->bitmaps
[i
].file
)
730 xfree (dpyinfo
->bitmaps
[i
].file
);
732 dpyinfo
->bitmaps_last
= 0;
735 /* Connect the frame-parameter names for X frames
736 to the ways of passing the parameter values to the window system.
738 The name of a parameter, as a Lisp symbol,
739 has an `x-frame-parameter' property which is an integer in Lisp
740 that is an index in this table. */
742 struct x_frame_parm_table
745 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
760 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
765 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
773 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
775 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
780 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
782 static struct x_frame_parm_table x_frame_parms
[] =
784 "auto-raise", x_set_autoraise
,
785 "auto-lower", x_set_autolower
,
786 "background-color", x_set_background_color
,
787 "border-color", x_set_border_color
,
788 "border-width", x_set_border_width
,
789 "cursor-color", x_set_cursor_color
,
790 "cursor-type", x_set_cursor_type
,
792 "foreground-color", x_set_foreground_color
,
793 "icon-name", x_set_icon_name
,
794 "icon-type", x_set_icon_type
,
795 "internal-border-width", x_set_internal_border_width
,
796 "menu-bar-lines", x_set_menu_bar_lines
,
797 "mouse-color", x_set_mouse_color
,
798 "name", x_explicitly_set_name
,
799 "scroll-bar-width", x_set_scroll_bar_width
,
800 "title", x_set_title
,
801 "unsplittable", x_set_unsplittable
,
802 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
803 "visibility", x_set_visibility
,
804 "tool-bar-lines", x_set_tool_bar_lines
,
805 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
806 "scroll-bar-background", x_set_scroll_bar_background
,
807 "screen-gamma", x_set_screen_gamma
810 /* Attach the `x-frame-parameter' properties to
811 the Lisp symbol names of parameters relevant to X. */
814 init_x_parm_symbols ()
818 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
819 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
823 /* Change the parameters of frame F as specified by ALIST.
824 If a parameter is not specially recognized, do nothing;
825 otherwise call the `x_set_...' function for that parameter. */
828 x_set_frame_parameters (f
, alist
)
834 /* If both of these parameters are present, it's more efficient to
835 set them both at once. So we wait until we've looked at the
836 entire list before we set them. */
840 Lisp_Object left
, top
;
842 /* Same with these. */
843 Lisp_Object icon_left
, icon_top
;
845 /* Record in these vectors all the parms specified. */
849 int left_no_change
= 0, top_no_change
= 0;
850 int icon_left_no_change
= 0, icon_top_no_change
= 0;
852 struct gcpro gcpro1
, gcpro2
;
855 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
858 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
859 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
861 /* Extract parm names and values into those vectors. */
864 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
869 parms
[i
] = Fcar (elt
);
870 values
[i
] = Fcdr (elt
);
873 /* TAIL and ALIST are not used again below here. */
876 GCPRO2 (*parms
, *values
);
880 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
881 because their values appear in VALUES and strings are not valid. */
882 top
= left
= Qunbound
;
883 icon_left
= icon_top
= Qunbound
;
885 /* Provide default values for HEIGHT and WIDTH. */
886 if (FRAME_NEW_WIDTH (f
))
887 width
= FRAME_NEW_WIDTH (f
);
889 width
= FRAME_WIDTH (f
);
891 if (FRAME_NEW_HEIGHT (f
))
892 height
= FRAME_NEW_HEIGHT (f
);
894 height
= FRAME_HEIGHT (f
);
896 /* Process foreground_color and background_color before anything else.
897 They are independent of other properties, but other properties (e.g.,
898 cursor_color) are dependent upon them. */
899 for (p
= 0; p
< i
; p
++)
901 Lisp_Object prop
, val
;
905 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
907 register Lisp_Object param_index
, old_value
;
909 param_index
= Fget (prop
, Qx_frame_parameter
);
910 old_value
= get_frame_param (f
, prop
);
911 store_frame_param (f
, prop
, val
);
912 if (NATNUMP (param_index
)
913 && (XFASTINT (param_index
)
914 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
915 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
919 /* Now process them in reverse of specified order. */
920 for (i
--; i
>= 0; i
--)
922 Lisp_Object prop
, val
;
927 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
928 width
= XFASTINT (val
);
929 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
930 height
= XFASTINT (val
);
931 else if (EQ (prop
, Qtop
))
933 else if (EQ (prop
, Qleft
))
935 else if (EQ (prop
, Qicon_top
))
937 else if (EQ (prop
, Qicon_left
))
939 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
940 /* Processed above. */
944 register Lisp_Object param_index
, old_value
;
946 param_index
= Fget (prop
, Qx_frame_parameter
);
947 old_value
= get_frame_param (f
, prop
);
948 store_frame_param (f
, prop
, val
);
949 if (NATNUMP (param_index
)
950 && (XFASTINT (param_index
)
951 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
952 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
956 /* Don't die if just one of these was set. */
957 if (EQ (left
, Qunbound
))
960 if (f
->output_data
.x
->left_pos
< 0)
961 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
963 XSETINT (left
, f
->output_data
.x
->left_pos
);
965 if (EQ (top
, Qunbound
))
968 if (f
->output_data
.x
->top_pos
< 0)
969 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
971 XSETINT (top
, f
->output_data
.x
->top_pos
);
974 /* If one of the icon positions was not set, preserve or default it. */
975 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
977 icon_left_no_change
= 1;
978 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
979 if (NILP (icon_left
))
980 XSETINT (icon_left
, 0);
982 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
984 icon_top_no_change
= 1;
985 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
987 XSETINT (icon_top
, 0);
990 /* Don't set these parameters unless they've been explicitly
991 specified. The window might be mapped or resized while we're in
992 this function, and we don't want to override that unless the lisp
993 code has asked for it.
995 Don't set these parameters unless they actually differ from the
996 window's current parameters; the window may not actually exist
1001 check_frame_size (f
, &height
, &width
);
1003 XSETFRAME (frame
, f
);
1005 if (width
!= FRAME_WIDTH (f
)
1006 || height
!= FRAME_HEIGHT (f
)
1007 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1008 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1010 if ((!NILP (left
) || !NILP (top
))
1011 && ! (left_no_change
&& top_no_change
)
1012 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1013 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1018 /* Record the signs. */
1019 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1020 if (EQ (left
, Qminus
))
1021 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1022 else if (INTEGERP (left
))
1024 leftpos
= XINT (left
);
1026 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1028 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1029 && CONSP (XCDR (left
))
1030 && INTEGERP (XCAR (XCDR (left
))))
1032 leftpos
= - XINT (XCAR (XCDR (left
)));
1033 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1035 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1036 && CONSP (XCDR (left
))
1037 && INTEGERP (XCAR (XCDR (left
))))
1039 leftpos
= XINT (XCAR (XCDR (left
)));
1042 if (EQ (top
, Qminus
))
1043 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1044 else if (INTEGERP (top
))
1046 toppos
= XINT (top
);
1048 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1050 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1051 && CONSP (XCDR (top
))
1052 && INTEGERP (XCAR (XCDR (top
))))
1054 toppos
= - XINT (XCAR (XCDR (top
)));
1055 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1057 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1058 && CONSP (XCDR (top
))
1059 && INTEGERP (XCAR (XCDR (top
))))
1061 toppos
= XINT (XCAR (XCDR (top
)));
1065 /* Store the numeric value of the position. */
1066 f
->output_data
.x
->top_pos
= toppos
;
1067 f
->output_data
.x
->left_pos
= leftpos
;
1069 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1071 /* Actually set that position, and convert to absolute. */
1072 x_set_offset (f
, leftpos
, toppos
, -1);
1075 if ((!NILP (icon_left
) || !NILP (icon_top
))
1076 && ! (icon_left_no_change
&& icon_top_no_change
))
1077 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1083 /* Store the screen positions of frame F into XPTR and YPTR.
1084 These are the positions of the containing window manager window,
1085 not Emacs's own window. */
1088 x_real_positions (f
, xptr
, yptr
)
1095 /* This is pretty gross, but seems to be the easiest way out of
1096 the problem that arises when restarting window-managers. */
1098 #ifdef USE_X_TOOLKIT
1099 Window outer
= (f
->output_data
.x
->widget
1100 ? XtWindow (f
->output_data
.x
->widget
)
1101 : FRAME_X_WINDOW (f
));
1103 Window outer
= f
->output_data
.x
->window_desc
;
1105 Window tmp_root_window
;
1106 Window
*tmp_children
;
1111 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1112 Window outer_window
;
1114 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1115 &f
->output_data
.x
->parent_desc
,
1116 &tmp_children
, &tmp_nchildren
);
1117 XFree ((char *) tmp_children
);
1121 /* Find the position of the outside upper-left corner of
1122 the inner window, with respect to the outer window. */
1123 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1124 outer_window
= f
->output_data
.x
->parent_desc
;
1126 outer_window
= outer
;
1128 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1130 /* From-window, to-window. */
1132 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1134 /* From-position, to-position. */
1135 0, 0, &win_x
, &win_y
,
1140 /* It is possible for the window returned by the XQueryNotify
1141 to become invalid by the time we call XTranslateCoordinates.
1142 That can happen when you restart some window managers.
1143 If so, we get an error in XTranslateCoordinates.
1144 Detect that and try the whole thing over. */
1145 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1147 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1151 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1158 /* Insert a description of internally-recorded parameters of frame X
1159 into the parameter alist *ALISTPTR that is to be given to the user.
1160 Only parameters that are specific to the X window system
1161 and whose values are not correctly recorded in the frame's
1162 param_alist need to be considered here. */
1165 x_report_frame_params (f
, alistptr
)
1167 Lisp_Object
*alistptr
;
1172 /* Represent negative positions (off the top or left screen edge)
1173 in a way that Fmodify_frame_parameters will understand correctly. */
1174 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1175 if (f
->output_data
.x
->left_pos
>= 0)
1176 store_in_alist (alistptr
, Qleft
, tem
);
1178 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1180 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1181 if (f
->output_data
.x
->top_pos
>= 0)
1182 store_in_alist (alistptr
, Qtop
, tem
);
1184 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1186 store_in_alist (alistptr
, Qborder_width
,
1187 make_number (f
->output_data
.x
->border_width
));
1188 store_in_alist (alistptr
, Qinternal_border_width
,
1189 make_number (f
->output_data
.x
->internal_border_width
));
1190 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1191 store_in_alist (alistptr
, Qwindow_id
,
1192 build_string (buf
));
1193 #ifdef USE_X_TOOLKIT
1194 /* Tooltip frame may not have this widget. */
1195 if (f
->output_data
.x
->widget
)
1197 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1198 store_in_alist (alistptr
, Qouter_window_id
,
1199 build_string (buf
));
1200 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1201 FRAME_SAMPLE_VISIBILITY (f
);
1202 store_in_alist (alistptr
, Qvisibility
,
1203 (FRAME_VISIBLE_P (f
) ? Qt
1204 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1205 store_in_alist (alistptr
, Qdisplay
,
1206 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1208 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1211 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1212 store_in_alist (alistptr
, Qparent_id
, tem
);
1217 /* Gamma-correct COLOR on frame F. */
1220 gamma_correct (f
, color
)
1226 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1227 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1228 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1233 /* Decide if color named COLOR is valid for the display associated with
1234 the selected frame; if so, return the rgb values in COLOR_DEF.
1235 If ALLOC is nonzero, allocate a new colormap cell. */
1238 defined_color (f
, color
, color_def
, alloc
)
1244 register int status
;
1245 Colormap screen_colormap
;
1246 Display
*display
= FRAME_X_DISPLAY (f
);
1249 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1251 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1252 if (status
&& alloc
)
1254 /* Apply gamma correction. */
1255 gamma_correct (f
, color_def
);
1257 status
= XAllocColor (display
, screen_colormap
, color_def
);
1260 /* If we got to this point, the colormap is full, so we're
1261 going to try and get the next closest color.
1262 The algorithm used is a least-squares matching, which is
1263 what X uses for closest color matching with StaticColor visuals. */
1268 long nearest_delta
, trial_delta
;
1271 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1272 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1274 for (x
= 0; x
< no_cells
; x
++)
1277 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1279 /* I'm assuming CSE so I'm not going to condense this. */
1280 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1281 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1283 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1284 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1286 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1287 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1288 for (x
= 1; x
< no_cells
; x
++)
1290 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1291 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1293 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1294 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1296 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1297 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1298 if (trial_delta
< nearest_delta
)
1301 temp
.red
= cells
[x
].red
;
1302 temp
.green
= cells
[x
].green
;
1303 temp
.blue
= cells
[x
].blue
;
1304 status
= XAllocColor (display
, screen_colormap
, &temp
);
1308 nearest_delta
= trial_delta
;
1312 color_def
->red
= cells
[nearest
].red
;
1313 color_def
->green
= cells
[nearest
].green
;
1314 color_def
->blue
= cells
[nearest
].blue
;
1315 status
= XAllocColor (display
, screen_colormap
, color_def
);
1326 /* Given a string ARG naming a color, compute a pixel value from it
1327 suitable for screen F.
1328 If F is not a color screen, return DEF (default) regardless of what
1332 x_decode_color (f
, arg
, def
)
1339 CHECK_STRING (arg
, 0);
1341 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1342 return BLACK_PIX_DEFAULT (f
);
1343 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1344 return WHITE_PIX_DEFAULT (f
);
1346 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1349 /* defined_color is responsible for coping with failures
1350 by looking for a near-miss. */
1351 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1354 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1355 Fcons (arg
, Qnil
)));
1358 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1359 the previous value of that parameter, NEW_VALUE is the new value. */
1362 x_set_screen_gamma (f
, new_value
, old_value
)
1364 Lisp_Object new_value
, old_value
;
1366 if (NILP (new_value
))
1368 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1369 /* The value 0.4545 is the normal viewing gamma. */
1370 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1372 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1373 Fcons (new_value
, Qnil
)));
1375 clear_face_cache (0);
1379 /* Functions called only from `x_set_frame_param'
1380 to set individual parameters.
1382 If FRAME_X_WINDOW (f) is 0,
1383 the frame is being created and its X-window does not exist yet.
1384 In that case, just record the parameter's new value
1385 in the standard place; do not attempt to change the window. */
1388 x_set_foreground_color (f
, arg
, oldval
)
1390 Lisp_Object arg
, oldval
;
1393 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1395 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1396 f
->output_data
.x
->foreground_pixel
= pixel
;
1398 if (FRAME_X_WINDOW (f
) != 0)
1401 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1402 f
->output_data
.x
->foreground_pixel
);
1403 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1404 f
->output_data
.x
->foreground_pixel
);
1406 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1407 if (FRAME_VISIBLE_P (f
))
1413 x_set_background_color (f
, arg
, oldval
)
1415 Lisp_Object arg
, oldval
;
1418 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1420 unload_color (f
, f
->output_data
.x
->background_pixel
);
1421 f
->output_data
.x
->background_pixel
= pixel
;
1423 if (FRAME_X_WINDOW (f
) != 0)
1426 /* The main frame area. */
1427 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1428 f
->output_data
.x
->background_pixel
);
1429 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1430 f
->output_data
.x
->background_pixel
);
1431 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1432 f
->output_data
.x
->background_pixel
);
1433 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1434 f
->output_data
.x
->background_pixel
);
1437 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1438 bar
= XSCROLL_BAR (bar
)->next
)
1439 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1440 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1441 f
->output_data
.x
->background_pixel
);
1445 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1447 if (FRAME_VISIBLE_P (f
))
1453 x_set_mouse_color (f
, arg
, oldval
)
1455 Lisp_Object arg
, oldval
;
1457 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1460 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1461 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1463 /* Don't let pointers be invisible. */
1464 if (mask_color
== pixel
1465 && mask_color
== f
->output_data
.x
->background_pixel
)
1466 pixel
= f
->output_data
.x
->foreground_pixel
;
1468 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1469 f
->output_data
.x
->mouse_pixel
= pixel
;
1473 /* It's not okay to crash if the user selects a screwy cursor. */
1474 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1476 if (!EQ (Qnil
, Vx_pointer_shape
))
1478 CHECK_NUMBER (Vx_pointer_shape
, 0);
1479 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1482 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1483 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1485 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1487 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1488 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1489 XINT (Vx_nontext_pointer_shape
));
1492 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1493 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1495 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1497 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1498 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1499 XINT (Vx_busy_pointer_shape
));
1502 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1503 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1505 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1506 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1508 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1509 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1510 XINT (Vx_mode_pointer_shape
));
1513 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1514 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1516 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1518 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1520 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1521 XINT (Vx_sensitive_text_pointer_shape
));
1524 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1526 /* Check and report errors with the above calls. */
1527 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1528 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1531 XColor fore_color
, back_color
;
1533 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1534 back_color
.pixel
= mask_color
;
1535 XQueryColor (FRAME_X_DISPLAY (f
),
1536 DefaultColormap (FRAME_X_DISPLAY (f
),
1537 DefaultScreen (FRAME_X_DISPLAY (f
))),
1539 XQueryColor (FRAME_X_DISPLAY (f
),
1540 DefaultColormap (FRAME_X_DISPLAY (f
),
1541 DefaultScreen (FRAME_X_DISPLAY (f
))),
1543 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1544 &fore_color
, &back_color
);
1545 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1546 &fore_color
, &back_color
);
1547 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1548 &fore_color
, &back_color
);
1549 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1550 &fore_color
, &back_color
);
1551 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1552 &fore_color
, &back_color
);
1555 if (FRAME_X_WINDOW (f
) != 0)
1556 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1558 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1559 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1560 f
->output_data
.x
->text_cursor
= cursor
;
1562 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1563 && f
->output_data
.x
->nontext_cursor
!= 0)
1564 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1565 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1567 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1568 && f
->output_data
.x
->busy_cursor
!= 0)
1569 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1570 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1572 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1573 && f
->output_data
.x
->modeline_cursor
!= 0)
1574 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1575 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1577 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1578 && f
->output_data
.x
->cross_cursor
!= 0)
1579 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1580 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1582 XFlush (FRAME_X_DISPLAY (f
));
1585 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1589 x_set_cursor_color (f
, arg
, oldval
)
1591 Lisp_Object arg
, oldval
;
1593 unsigned long fore_pixel
, pixel
;
1595 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1596 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1597 WHITE_PIX_DEFAULT (f
));
1599 fore_pixel
= f
->output_data
.x
->background_pixel
;
1600 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1602 /* Make sure that the cursor color differs from the background color. */
1603 if (pixel
== f
->output_data
.x
->background_pixel
)
1605 pixel
= f
->output_data
.x
->mouse_pixel
;
1606 if (pixel
== fore_pixel
)
1607 fore_pixel
= f
->output_data
.x
->background_pixel
;
1610 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1611 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1613 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1614 f
->output_data
.x
->cursor_pixel
= pixel
;
1616 if (FRAME_X_WINDOW (f
) != 0)
1619 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1620 f
->output_data
.x
->cursor_pixel
);
1621 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1625 if (FRAME_VISIBLE_P (f
))
1627 x_update_cursor (f
, 0);
1628 x_update_cursor (f
, 1);
1632 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1635 /* Set the border-color of frame F to value described by ARG.
1636 ARG can be a string naming a color.
1637 The border-color is used for the border that is drawn by the X server.
1638 Note that this does not fully take effect if done before
1639 F has an x-window; it must be redone when the window is created.
1641 Note: this is done in two routines because of the way X10 works.
1643 Note: under X11, this is normally the province of the window manager,
1644 and so emacs' border colors may be overridden. */
1647 x_set_border_color (f
, arg
, oldval
)
1649 Lisp_Object arg
, oldval
;
1653 CHECK_STRING (arg
, 0);
1654 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1655 x_set_border_pixel (f
, pix
);
1656 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1659 /* Set the border-color of frame F to pixel value PIX.
1660 Note that this does not fully take effect if done before
1661 F has an x-window. */
1664 x_set_border_pixel (f
, pix
)
1668 unload_color (f
, f
->output_data
.x
->border_pixel
);
1669 f
->output_data
.x
->border_pixel
= pix
;
1671 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1674 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1675 (unsigned long)pix
);
1678 if (FRAME_VISIBLE_P (f
))
1684 x_set_cursor_type (f
, arg
, oldval
)
1686 Lisp_Object arg
, oldval
;
1690 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1691 f
->output_data
.x
->cursor_width
= 2;
1693 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1694 && INTEGERP (XCDR (arg
)))
1696 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1697 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1700 /* Treat anything unknown as "box cursor".
1701 It was bad to signal an error; people have trouble fixing
1702 .Xdefaults with Emacs, when it has something bad in it. */
1703 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1705 /* Make sure the cursor gets redrawn. This is overkill, but how
1706 often do people change cursor types? */
1707 update_mode_lines
++;
1711 x_set_icon_type (f
, arg
, oldval
)
1713 Lisp_Object arg
, oldval
;
1719 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1722 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1727 result
= x_text_icon (f
,
1728 (char *) XSTRING ((!NILP (f
->icon_name
)
1732 result
= x_bitmap_icon (f
, arg
);
1737 error ("No icon window available");
1740 XFlush (FRAME_X_DISPLAY (f
));
1744 /* Return non-nil if frame F wants a bitmap icon. */
1752 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1760 x_set_icon_name (f
, arg
, oldval
)
1762 Lisp_Object arg
, oldval
;
1768 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1771 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1776 if (f
->output_data
.x
->icon_bitmap
!= 0)
1781 result
= x_text_icon (f
,
1782 (char *) XSTRING ((!NILP (f
->icon_name
)
1791 error ("No icon window available");
1794 XFlush (FRAME_X_DISPLAY (f
));
1799 x_set_font (f
, arg
, oldval
)
1801 Lisp_Object arg
, oldval
;
1804 Lisp_Object fontset_name
;
1807 CHECK_STRING (arg
, 1);
1809 fontset_name
= Fquery_fontset (arg
, Qnil
);
1812 result
= (STRINGP (fontset_name
)
1813 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1814 : x_new_font (f
, XSTRING (arg
)->data
));
1817 if (EQ (result
, Qnil
))
1818 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1819 else if (EQ (result
, Qt
))
1820 error ("The characters of the given font have varying widths");
1821 else if (STRINGP (result
))
1823 store_frame_param (f
, Qfont
, result
);
1824 recompute_basic_faces (f
);
1829 do_pending_window_change (0);
1831 /* Don't call `face-set-after-frame-default' when faces haven't been
1832 initialized yet. This is the case when called from
1833 Fx_create_frame. In that case, the X widget or window doesn't
1834 exist either, and we can end up in x_report_frame_params with a
1835 null widget which gives a segfault. */
1836 if (FRAME_FACE_CACHE (f
))
1838 XSETFRAME (frame
, f
);
1839 call1 (Qface_set_after_frame_default
, frame
);
1844 x_set_border_width (f
, arg
, oldval
)
1846 Lisp_Object arg
, oldval
;
1848 CHECK_NUMBER (arg
, 0);
1850 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1853 if (FRAME_X_WINDOW (f
) != 0)
1854 error ("Cannot change the border width of a window");
1856 f
->output_data
.x
->border_width
= XINT (arg
);
1860 x_set_internal_border_width (f
, arg
, oldval
)
1862 Lisp_Object arg
, oldval
;
1864 int old
= f
->output_data
.x
->internal_border_width
;
1866 CHECK_NUMBER (arg
, 0);
1867 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1868 if (f
->output_data
.x
->internal_border_width
< 0)
1869 f
->output_data
.x
->internal_border_width
= 0;
1871 #ifdef USE_X_TOOLKIT
1872 if (f
->output_data
.x
->edit_widget
)
1873 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1876 if (f
->output_data
.x
->internal_border_width
== old
)
1879 if (FRAME_X_WINDOW (f
) != 0)
1881 x_set_window_size (f
, 0, f
->width
, f
->height
);
1882 SET_FRAME_GARBAGED (f
);
1883 do_pending_window_change (0);
1888 x_set_visibility (f
, value
, oldval
)
1890 Lisp_Object value
, oldval
;
1893 XSETFRAME (frame
, f
);
1896 Fmake_frame_invisible (frame
, Qt
);
1897 else if (EQ (value
, Qicon
))
1898 Ficonify_frame (frame
);
1900 Fmake_frame_visible (frame
);
1904 x_set_menu_bar_lines_1 (window
, n
)
1908 struct window
*w
= XWINDOW (window
);
1910 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1911 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1913 /* Handle just the top child in a vertical split. */
1914 if (!NILP (w
->vchild
))
1915 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1917 /* Adjust all children in a horizontal split. */
1918 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1920 w
= XWINDOW (window
);
1921 x_set_menu_bar_lines_1 (window
, n
);
1926 x_set_menu_bar_lines (f
, value
, oldval
)
1928 Lisp_Object value
, oldval
;
1931 #ifndef USE_X_TOOLKIT
1932 int olines
= FRAME_MENU_BAR_LINES (f
);
1935 /* Right now, menu bars don't work properly in minibuf-only frames;
1936 most of the commands try to apply themselves to the minibuffer
1937 frame itself, and get an error because you can't switch buffers
1938 in or split the minibuffer window. */
1939 if (FRAME_MINIBUF_ONLY_P (f
))
1942 if (INTEGERP (value
))
1943 nlines
= XINT (value
);
1947 /* Make sure we redisplay all windows in this frame. */
1948 windows_or_buffers_changed
++;
1950 #ifdef USE_X_TOOLKIT
1951 FRAME_MENU_BAR_LINES (f
) = 0;
1954 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1955 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1956 /* Make sure next redisplay shows the menu bar. */
1957 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1961 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1962 free_frame_menubar (f
);
1963 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1965 f
->output_data
.x
->menubar_widget
= 0;
1967 #else /* not USE_X_TOOLKIT */
1968 FRAME_MENU_BAR_LINES (f
) = nlines
;
1969 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1970 #endif /* not USE_X_TOOLKIT */
1975 /* Set the number of lines used for the tool bar of frame F to VALUE.
1976 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1977 is the old number of tool bar lines. This function changes the
1978 height of all windows on frame F to match the new tool bar height.
1979 The frame's height doesn't change. */
1982 x_set_tool_bar_lines (f
, value
, oldval
)
1984 Lisp_Object value
, oldval
;
1988 /* Use VALUE only if an integer >= 0. */
1989 if (INTEGERP (value
) && XINT (value
) >= 0)
1990 nlines
= XFASTINT (value
);
1994 /* Make sure we redisplay all windows in this frame. */
1995 ++windows_or_buffers_changed
;
1997 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1998 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1999 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2004 /* Set the foreground color for scroll bars on frame F to VALUE.
2005 VALUE should be a string, a color name. If it isn't a string or
2006 isn't a valid color name, do nothing. OLDVAL is the old value of
2007 the frame parameter. */
2010 x_set_scroll_bar_foreground (f
, value
, oldval
)
2012 Lisp_Object value
, oldval
;
2014 unsigned long pixel
;
2016 if (STRINGP (value
))
2017 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2021 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2022 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2024 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2025 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2027 /* Remove all scroll bars because they have wrong colors. */
2028 if (condemn_scroll_bars_hook
)
2029 (*condemn_scroll_bars_hook
) (f
);
2030 if (judge_scroll_bars_hook
)
2031 (*judge_scroll_bars_hook
) (f
);
2033 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2039 /* Set the background color for scroll bars on frame F to VALUE VALUE
2040 should be a string, a color name. If it isn't a string or isn't a
2041 valid color name, do nothing. OLDVAL is the old value of the frame
2045 x_set_scroll_bar_background (f
, value
, oldval
)
2047 Lisp_Object value
, oldval
;
2049 unsigned long pixel
;
2051 if (STRINGP (value
))
2052 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2056 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2057 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2059 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2060 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2062 /* Remove all scroll bars because they have wrong colors. */
2063 if (condemn_scroll_bars_hook
)
2064 (*condemn_scroll_bars_hook
) (f
);
2065 if (judge_scroll_bars_hook
)
2066 (*judge_scroll_bars_hook
) (f
);
2068 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2074 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2077 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2078 name; if NAME is a string, set F's name to NAME and set
2079 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2081 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2082 suggesting a new name, which lisp code should override; if
2083 F->explicit_name is set, ignore the new name; otherwise, set it. */
2086 x_set_name (f
, name
, explicit)
2091 /* Make sure that requests from lisp code override requests from
2092 Emacs redisplay code. */
2095 /* If we're switching from explicit to implicit, we had better
2096 update the mode lines and thereby update the title. */
2097 if (f
->explicit_name
&& NILP (name
))
2098 update_mode_lines
= 1;
2100 f
->explicit_name
= ! NILP (name
);
2102 else if (f
->explicit_name
)
2105 /* If NAME is nil, set the name to the x_id_name. */
2108 /* Check for no change needed in this very common case
2109 before we do any consing. */
2110 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2111 XSTRING (f
->name
)->data
))
2113 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2116 CHECK_STRING (name
, 0);
2118 /* Don't change the name if it's already NAME. */
2119 if (! NILP (Fstring_equal (name
, f
->name
)))
2124 /* For setting the frame title, the title parameter should override
2125 the name parameter. */
2126 if (! NILP (f
->title
))
2129 if (FRAME_X_WINDOW (f
))
2134 XTextProperty text
, icon
;
2135 Lisp_Object icon_name
;
2137 text
.value
= XSTRING (name
)->data
;
2138 text
.encoding
= XA_STRING
;
2140 text
.nitems
= STRING_BYTES (XSTRING (name
));
2142 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2144 icon
.value
= XSTRING (icon_name
)->data
;
2145 icon
.encoding
= XA_STRING
;
2147 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2148 #ifdef USE_X_TOOLKIT
2149 XSetWMName (FRAME_X_DISPLAY (f
),
2150 XtWindow (f
->output_data
.x
->widget
), &text
);
2151 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2153 #else /* not USE_X_TOOLKIT */
2154 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2155 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2156 #endif /* not USE_X_TOOLKIT */
2158 #else /* not HAVE_X11R4 */
2159 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2160 XSTRING (name
)->data
);
2161 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2162 XSTRING (name
)->data
);
2163 #endif /* not HAVE_X11R4 */
2168 /* This function should be called when the user's lisp code has
2169 specified a name for the frame; the name will override any set by the
2172 x_explicitly_set_name (f
, arg
, oldval
)
2174 Lisp_Object arg
, oldval
;
2176 x_set_name (f
, arg
, 1);
2179 /* This function should be called by Emacs redisplay code to set the
2180 name; names set this way will never override names set by the user's
2183 x_implicitly_set_name (f
, arg
, oldval
)
2185 Lisp_Object arg
, oldval
;
2187 x_set_name (f
, arg
, 0);
2190 /* Change the title of frame F to NAME.
2191 If NAME is nil, use the frame name as the title.
2193 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2194 name; if NAME is a string, set F's name to NAME and set
2195 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2197 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2198 suggesting a new name, which lisp code should override; if
2199 F->explicit_name is set, ignore the new name; otherwise, set it. */
2202 x_set_title (f
, name
, old_name
)
2204 Lisp_Object name
, old_name
;
2206 /* Don't change the title if it's already NAME. */
2207 if (EQ (name
, f
->title
))
2210 update_mode_lines
= 1;
2217 CHECK_STRING (name
, 0);
2219 if (FRAME_X_WINDOW (f
))
2224 XTextProperty text
, icon
;
2225 Lisp_Object icon_name
;
2227 text
.value
= XSTRING (name
)->data
;
2228 text
.encoding
= XA_STRING
;
2230 text
.nitems
= STRING_BYTES (XSTRING (name
));
2232 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2234 icon
.value
= XSTRING (icon_name
)->data
;
2235 icon
.encoding
= XA_STRING
;
2237 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2238 #ifdef USE_X_TOOLKIT
2239 XSetWMName (FRAME_X_DISPLAY (f
),
2240 XtWindow (f
->output_data
.x
->widget
), &text
);
2241 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2243 #else /* not USE_X_TOOLKIT */
2244 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2245 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2246 #endif /* not USE_X_TOOLKIT */
2248 #else /* not HAVE_X11R4 */
2249 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2250 XSTRING (name
)->data
);
2251 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2252 XSTRING (name
)->data
);
2253 #endif /* not HAVE_X11R4 */
2259 x_set_autoraise (f
, arg
, oldval
)
2261 Lisp_Object arg
, oldval
;
2263 f
->auto_raise
= !EQ (Qnil
, arg
);
2267 x_set_autolower (f
, arg
, oldval
)
2269 Lisp_Object arg
, oldval
;
2271 f
->auto_lower
= !EQ (Qnil
, arg
);
2275 x_set_unsplittable (f
, arg
, oldval
)
2277 Lisp_Object arg
, oldval
;
2279 f
->no_split
= !NILP (arg
);
2283 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2285 Lisp_Object arg
, oldval
;
2287 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2288 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2289 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2290 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2292 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2294 ? vertical_scroll_bar_none
2296 ? vertical_scroll_bar_right
2297 : vertical_scroll_bar_left
);
2299 /* We set this parameter before creating the X window for the
2300 frame, so we can get the geometry right from the start.
2301 However, if the window hasn't been created yet, we shouldn't
2302 call x_set_window_size. */
2303 if (FRAME_X_WINDOW (f
))
2304 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2305 do_pending_window_change (0);
2310 x_set_scroll_bar_width (f
, arg
, oldval
)
2312 Lisp_Object arg
, oldval
;
2314 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2318 #ifdef USE_TOOLKIT_SCROLL_BARS
2319 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2320 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2321 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2322 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2324 /* Make the actual width at least 14 pixels and a multiple of a
2326 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2328 /* Use all of that space (aside from required margins) for the
2330 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2333 if (FRAME_X_WINDOW (f
))
2334 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2335 do_pending_window_change (0);
2337 else if (INTEGERP (arg
) && XINT (arg
) > 0
2338 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2340 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2341 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2343 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2344 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2345 if (FRAME_X_WINDOW (f
))
2346 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2349 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2350 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2351 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2356 /* Subroutines of creating an X frame. */
2358 /* Make sure that Vx_resource_name is set to a reasonable value.
2359 Fix it up, or set it to `emacs' if it is too hopeless. */
2362 validate_x_resource_name ()
2365 /* Number of valid characters in the resource name. */
2367 /* Number of invalid characters in the resource name. */
2372 if (!STRINGP (Vx_resource_class
))
2373 Vx_resource_class
= build_string (EMACS_CLASS
);
2375 if (STRINGP (Vx_resource_name
))
2377 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2380 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2382 /* Only letters, digits, - and _ are valid in resource names.
2383 Count the valid characters and count the invalid ones. */
2384 for (i
= 0; i
< len
; i
++)
2387 if (! ((c
>= 'a' && c
<= 'z')
2388 || (c
>= 'A' && c
<= 'Z')
2389 || (c
>= '0' && c
<= '9')
2390 || c
== '-' || c
== '_'))
2397 /* Not a string => completely invalid. */
2398 bad_count
= 5, good_count
= 0;
2400 /* If name is valid already, return. */
2404 /* If name is entirely invalid, or nearly so, use `emacs'. */
2406 || (good_count
== 1 && bad_count
> 0))
2408 Vx_resource_name
= build_string ("emacs");
2412 /* Name is partly valid. Copy it and replace the invalid characters
2413 with underscores. */
2415 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2417 for (i
= 0; i
< len
; i
++)
2419 int c
= XSTRING (new)->data
[i
];
2420 if (! ((c
>= 'a' && c
<= 'z')
2421 || (c
>= 'A' && c
<= 'Z')
2422 || (c
>= '0' && c
<= '9')
2423 || c
== '-' || c
== '_'))
2424 XSTRING (new)->data
[i
] = '_';
2429 extern char *x_get_string_resource ();
2431 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2432 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2433 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2434 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2435 the name specified by the `-name' or `-rn' command-line arguments.\n\
2437 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2438 class, respectively. You must specify both of them or neither.\n\
2439 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2440 and the class is `Emacs.CLASS.SUBCLASS'.")
2441 (attribute
, class, component
, subclass
)
2442 Lisp_Object attribute
, class, component
, subclass
;
2444 register char *value
;
2450 CHECK_STRING (attribute
, 0);
2451 CHECK_STRING (class, 0);
2453 if (!NILP (component
))
2454 CHECK_STRING (component
, 1);
2455 if (!NILP (subclass
))
2456 CHECK_STRING (subclass
, 2);
2457 if (NILP (component
) != NILP (subclass
))
2458 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2460 validate_x_resource_name ();
2462 /* Allocate space for the components, the dots which separate them,
2463 and the final '\0'. Make them big enough for the worst case. */
2464 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2465 + (STRINGP (component
)
2466 ? STRING_BYTES (XSTRING (component
)) : 0)
2467 + STRING_BYTES (XSTRING (attribute
))
2470 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2471 + STRING_BYTES (XSTRING (class))
2472 + (STRINGP (subclass
)
2473 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2476 /* Start with emacs.FRAMENAME for the name (the specific one)
2477 and with `Emacs' for the class key (the general one). */
2478 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2479 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2481 strcat (class_key
, ".");
2482 strcat (class_key
, XSTRING (class)->data
);
2484 if (!NILP (component
))
2486 strcat (class_key
, ".");
2487 strcat (class_key
, XSTRING (subclass
)->data
);
2489 strcat (name_key
, ".");
2490 strcat (name_key
, XSTRING (component
)->data
);
2493 strcat (name_key
, ".");
2494 strcat (name_key
, XSTRING (attribute
)->data
);
2496 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2497 name_key
, class_key
);
2499 if (value
!= (char *) 0)
2500 return build_string (value
);
2505 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2508 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2509 struct x_display_info
*dpyinfo
;
2510 Lisp_Object attribute
, class, component
, subclass
;
2512 register char *value
;
2518 CHECK_STRING (attribute
, 0);
2519 CHECK_STRING (class, 0);
2521 if (!NILP (component
))
2522 CHECK_STRING (component
, 1);
2523 if (!NILP (subclass
))
2524 CHECK_STRING (subclass
, 2);
2525 if (NILP (component
) != NILP (subclass
))
2526 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2528 validate_x_resource_name ();
2530 /* Allocate space for the components, the dots which separate them,
2531 and the final '\0'. Make them big enough for the worst case. */
2532 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2533 + (STRINGP (component
)
2534 ? STRING_BYTES (XSTRING (component
)) : 0)
2535 + STRING_BYTES (XSTRING (attribute
))
2538 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2539 + STRING_BYTES (XSTRING (class))
2540 + (STRINGP (subclass
)
2541 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2544 /* Start with emacs.FRAMENAME for the name (the specific one)
2545 and with `Emacs' for the class key (the general one). */
2546 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2547 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2549 strcat (class_key
, ".");
2550 strcat (class_key
, XSTRING (class)->data
);
2552 if (!NILP (component
))
2554 strcat (class_key
, ".");
2555 strcat (class_key
, XSTRING (subclass
)->data
);
2557 strcat (name_key
, ".");
2558 strcat (name_key
, XSTRING (component
)->data
);
2561 strcat (name_key
, ".");
2562 strcat (name_key
, XSTRING (attribute
)->data
);
2564 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2566 if (value
!= (char *) 0)
2567 return build_string (value
);
2572 /* Used when C code wants a resource value. */
2575 x_get_resource_string (attribute
, class)
2576 char *attribute
, *class;
2580 struct frame
*sf
= SELECTED_FRAME ();
2582 /* Allocate space for the components, the dots which separate them,
2583 and the final '\0'. */
2584 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2585 + strlen (attribute
) + 2);
2586 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2587 + strlen (class) + 2);
2589 sprintf (name_key
, "%s.%s",
2590 XSTRING (Vinvocation_name
)->data
,
2592 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2594 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2595 name_key
, class_key
);
2598 /* Types we might convert a resource string into. */
2608 /* Return the value of parameter PARAM.
2610 First search ALIST, then Vdefault_frame_alist, then the X defaults
2611 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2613 Convert the resource to the type specified by desired_type.
2615 If no default is specified, return Qunbound. If you call
2616 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2617 and don't let it get stored in any Lisp-visible variables! */
2620 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2621 struct x_display_info
*dpyinfo
;
2622 Lisp_Object alist
, param
;
2625 enum resource_types type
;
2627 register Lisp_Object tem
;
2629 tem
= Fassq (param
, alist
);
2631 tem
= Fassq (param
, Vdefault_frame_alist
);
2637 tem
= display_x_get_resource (dpyinfo
,
2638 build_string (attribute
),
2639 build_string (class),
2647 case RES_TYPE_NUMBER
:
2648 return make_number (atoi (XSTRING (tem
)->data
));
2650 case RES_TYPE_FLOAT
:
2651 return make_float (atof (XSTRING (tem
)->data
));
2653 case RES_TYPE_BOOLEAN
:
2654 tem
= Fdowncase (tem
);
2655 if (!strcmp (XSTRING (tem
)->data
, "on")
2656 || !strcmp (XSTRING (tem
)->data
, "true"))
2661 case RES_TYPE_STRING
:
2664 case RES_TYPE_SYMBOL
:
2665 /* As a special case, we map the values `true' and `on'
2666 to Qt, and `false' and `off' to Qnil. */
2669 lower
= Fdowncase (tem
);
2670 if (!strcmp (XSTRING (lower
)->data
, "on")
2671 || !strcmp (XSTRING (lower
)->data
, "true"))
2673 else if (!strcmp (XSTRING (lower
)->data
, "off")
2674 || !strcmp (XSTRING (lower
)->data
, "false"))
2677 return Fintern (tem
, Qnil
);
2690 /* Like x_get_arg, but also record the value in f->param_alist. */
2693 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2695 Lisp_Object alist
, param
;
2698 enum resource_types type
;
2702 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2703 attribute
, class, type
);
2705 store_frame_param (f
, param
, value
);
2710 /* Record in frame F the specified or default value according to ALIST
2711 of the parameter named PROP (a Lisp symbol).
2712 If no value is specified for PROP, look for an X default for XPROP
2713 on the frame named NAME.
2714 If that is not found either, use the value DEFLT. */
2717 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2724 enum resource_types type
;
2728 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2729 if (EQ (tem
, Qunbound
))
2731 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2736 /* Record in frame F the specified or default value according to ALIST
2737 of the parameter named PROP (a Lisp symbol). If no value is
2738 specified for PROP, look for an X default for XPROP on the frame
2739 named NAME. If that is not found either, use the value DEFLT. */
2742 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2751 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2754 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2755 if (EQ (tem
, Qunbound
))
2757 #ifdef USE_TOOLKIT_SCROLL_BARS
2759 /* See if an X resource for the scroll bar color has been
2761 tem
= display_x_get_resource (dpyinfo
,
2762 build_string (foreground_p
2766 build_string ("verticalScrollBar"),
2770 /* If nothing has been specified, scroll bars will use a
2771 toolkit-dependent default. Because these defaults are
2772 difficult to get at without actually creating a scroll
2773 bar, use nil to indicate that no color has been
2778 #else /* not USE_TOOLKIT_SCROLL_BARS */
2782 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2785 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2791 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2792 "Parse an X-style geometry string STRING.\n\
2793 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2794 The properties returned may include `top', `left', `height', and `width'.\n\
2795 The value of `left' or `top' may be an integer,\n\
2796 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2797 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2802 unsigned int width
, height
;
2805 CHECK_STRING (string
, 0);
2807 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2808 &x
, &y
, &width
, &height
);
2811 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2812 error ("Must specify both x and y position, or neither");
2816 if (geometry
& XValue
)
2818 Lisp_Object element
;
2820 if (x
>= 0 && (geometry
& XNegative
))
2821 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2822 else if (x
< 0 && ! (geometry
& XNegative
))
2823 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2825 element
= Fcons (Qleft
, make_number (x
));
2826 result
= Fcons (element
, result
);
2829 if (geometry
& YValue
)
2831 Lisp_Object element
;
2833 if (y
>= 0 && (geometry
& YNegative
))
2834 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2835 else if (y
< 0 && ! (geometry
& YNegative
))
2836 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2838 element
= Fcons (Qtop
, make_number (y
));
2839 result
= Fcons (element
, result
);
2842 if (geometry
& WidthValue
)
2843 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2844 if (geometry
& HeightValue
)
2845 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2850 /* Calculate the desired size and position of this window,
2851 and return the flags saying which aspects were specified.
2853 This function does not make the coordinates positive. */
2855 #define DEFAULT_ROWS 40
2856 #define DEFAULT_COLS 80
2859 x_figure_window_size (f
, parms
)
2863 register Lisp_Object tem0
, tem1
, tem2
;
2864 long window_prompting
= 0;
2865 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2867 /* Default values if we fall through.
2868 Actually, if that happens we should get
2869 window manager prompting. */
2870 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2871 f
->height
= DEFAULT_ROWS
;
2872 /* Window managers expect that if program-specified
2873 positions are not (0,0), they're intentional, not defaults. */
2874 f
->output_data
.x
->top_pos
= 0;
2875 f
->output_data
.x
->left_pos
= 0;
2877 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2878 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2879 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2880 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2882 if (!EQ (tem0
, Qunbound
))
2884 CHECK_NUMBER (tem0
, 0);
2885 f
->height
= XINT (tem0
);
2887 if (!EQ (tem1
, Qunbound
))
2889 CHECK_NUMBER (tem1
, 0);
2890 SET_FRAME_WIDTH (f
, XINT (tem1
));
2892 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2893 window_prompting
|= USSize
;
2895 window_prompting
|= PSize
;
2898 f
->output_data
.x
->vertical_scroll_bar_extra
2899 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2901 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2902 f
->output_data
.x
->flags_areas_extra
2903 = FRAME_FLAGS_AREA_WIDTH (f
);
2904 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2905 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2907 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2908 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2909 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2910 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2912 if (EQ (tem0
, Qminus
))
2914 f
->output_data
.x
->top_pos
= 0;
2915 window_prompting
|= YNegative
;
2917 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2918 && CONSP (XCDR (tem0
))
2919 && INTEGERP (XCAR (XCDR (tem0
))))
2921 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2922 window_prompting
|= YNegative
;
2924 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2925 && CONSP (XCDR (tem0
))
2926 && INTEGERP (XCAR (XCDR (tem0
))))
2928 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2930 else if (EQ (tem0
, Qunbound
))
2931 f
->output_data
.x
->top_pos
= 0;
2934 CHECK_NUMBER (tem0
, 0);
2935 f
->output_data
.x
->top_pos
= XINT (tem0
);
2936 if (f
->output_data
.x
->top_pos
< 0)
2937 window_prompting
|= YNegative
;
2940 if (EQ (tem1
, Qminus
))
2942 f
->output_data
.x
->left_pos
= 0;
2943 window_prompting
|= XNegative
;
2945 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2946 && CONSP (XCDR (tem1
))
2947 && INTEGERP (XCAR (XCDR (tem1
))))
2949 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2950 window_prompting
|= XNegative
;
2952 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2953 && CONSP (XCDR (tem1
))
2954 && INTEGERP (XCAR (XCDR (tem1
))))
2956 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2958 else if (EQ (tem1
, Qunbound
))
2959 f
->output_data
.x
->left_pos
= 0;
2962 CHECK_NUMBER (tem1
, 0);
2963 f
->output_data
.x
->left_pos
= XINT (tem1
);
2964 if (f
->output_data
.x
->left_pos
< 0)
2965 window_prompting
|= XNegative
;
2968 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2969 window_prompting
|= USPosition
;
2971 window_prompting
|= PPosition
;
2974 return window_prompting
;
2977 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2980 XSetWMProtocols (dpy
, w
, protocols
, count
)
2987 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2988 if (prop
== None
) return False
;
2989 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2990 (unsigned char *) protocols
, count
);
2993 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2995 #ifdef USE_X_TOOLKIT
2997 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2998 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2999 already be present because of the toolkit (Motif adds some of them,
3000 for example, but Xt doesn't). */
3003 hack_wm_protocols (f
, widget
)
3007 Display
*dpy
= XtDisplay (widget
);
3008 Window w
= XtWindow (widget
);
3009 int need_delete
= 1;
3015 Atom type
, *atoms
= 0;
3017 unsigned long nitems
= 0;
3018 unsigned long bytes_after
;
3020 if ((XGetWindowProperty (dpy
, w
,
3021 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3022 (long)0, (long)100, False
, XA_ATOM
,
3023 &type
, &format
, &nitems
, &bytes_after
,
3024 (unsigned char **) &atoms
)
3026 && format
== 32 && type
== XA_ATOM
)
3030 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3032 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3034 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3037 if (atoms
) XFree ((char *) atoms
);
3043 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3045 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3047 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3049 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3050 XA_ATOM
, 32, PropModeAppend
,
3051 (unsigned char *) props
, count
);
3057 #ifdef USE_X_TOOLKIT
3059 /* Create and set up the X widget for frame F. */
3062 x_window (f
, window_prompting
, minibuffer_only
)
3064 long window_prompting
;
3065 int minibuffer_only
;
3067 XClassHint class_hints
;
3068 XSetWindowAttributes attributes
;
3069 unsigned long attribute_mask
;
3071 Widget shell_widget
;
3073 Widget frame_widget
;
3079 /* Use the resource name as the top-level widget name
3080 for looking up resources. Make a non-Lisp copy
3081 for the window manager, so GC relocation won't bother it.
3083 Elsewhere we specify the window name for the window manager. */
3086 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3087 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3088 strcpy (f
->namebuf
, str
);
3092 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3093 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3094 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3095 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3096 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3097 applicationShellWidgetClass
,
3098 FRAME_X_DISPLAY (f
), al
, ac
);
3100 f
->output_data
.x
->widget
= shell_widget
;
3101 /* maybe_set_screen_title_format (shell_widget); */
3103 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3104 (widget_value
*) NULL
,
3105 shell_widget
, False
,
3108 (lw_callback
) NULL
);
3110 f
->output_data
.x
->column_widget
= pane_widget
;
3112 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3113 the emacs screen when changing menubar. This reduces flickering. */
3116 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3117 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3118 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3119 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3120 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3121 frame_widget
= XtCreateWidget (f
->namebuf
,
3123 pane_widget
, al
, ac
);
3125 f
->output_data
.x
->edit_widget
= frame_widget
;
3127 XtManageChild (frame_widget
);
3129 /* Do some needed geometry management. */
3132 char *tem
, shell_position
[32];
3135 int extra_borders
= 0;
3137 = (f
->output_data
.x
->menubar_widget
3138 ? (f
->output_data
.x
->menubar_widget
->core
.height
3139 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3142 #if 0 /* Experimentally, we now get the right results
3143 for -geometry -0-0 without this. 24 Aug 96, rms. */
3144 if (FRAME_EXTERNAL_MENU_BAR (f
))
3147 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3148 menubar_size
+= ibw
;
3152 f
->output_data
.x
->menubar_height
= menubar_size
;
3155 /* Motif seems to need this amount added to the sizes
3156 specified for the shell widget. The Athena/Lucid widgets don't.
3157 Both conclusions reached experimentally. -- rms. */
3158 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3159 &extra_borders
, NULL
);
3163 /* Convert our geometry parameters into a geometry string
3165 Note that we do not specify here whether the position
3166 is a user-specified or program-specified one.
3167 We pass that information later, in x_wm_set_size_hints. */
3169 int left
= f
->output_data
.x
->left_pos
;
3170 int xneg
= window_prompting
& XNegative
;
3171 int top
= f
->output_data
.x
->top_pos
;
3172 int yneg
= window_prompting
& YNegative
;
3178 if (window_prompting
& USPosition
)
3179 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3180 PIXEL_WIDTH (f
) + extra_borders
,
3181 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3182 (xneg
? '-' : '+'), left
,
3183 (yneg
? '-' : '+'), top
);
3185 sprintf (shell_position
, "=%dx%d",
3186 PIXEL_WIDTH (f
) + extra_borders
,
3187 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3190 len
= strlen (shell_position
) + 1;
3191 /* We don't free this because we don't know whether
3192 it is safe to free it while the frame exists.
3193 It isn't worth the trouble of arranging to free it
3194 when the frame is deleted. */
3195 tem
= (char *) xmalloc (len
);
3196 strncpy (tem
, shell_position
, len
);
3197 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3198 XtSetValues (shell_widget
, al
, ac
);
3201 XtManageChild (pane_widget
);
3202 XtRealizeWidget (shell_widget
);
3204 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3206 validate_x_resource_name ();
3208 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3209 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3210 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3213 #ifndef X_I18N_INHIBITED
3218 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
3222 xic
= XCreateIC (xim
,
3223 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3224 XNClientWindow
, FRAME_X_WINDOW(f
),
3225 XNFocusWindow
, FRAME_X_WINDOW(f
),
3234 FRAME_XIM (f
) = xim
;
3235 FRAME_XIC (f
) = xic
;
3237 #else /* X_I18N_INHIBITED */
3240 #endif /* X_I18N_INHIBITED */
3241 #endif /* HAVE_X_I18N */
3243 f
->output_data
.x
->wm_hints
.input
= True
;
3244 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3245 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3246 &f
->output_data
.x
->wm_hints
);
3248 hack_wm_protocols (f
, shell_widget
);
3251 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3254 /* Do a stupid property change to force the server to generate a
3255 PropertyNotify event so that the event_stream server timestamp will
3256 be initialized to something relevant to the time we created the window.
3258 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3259 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3260 XA_ATOM
, 32, PropModeAppend
,
3261 (unsigned char*) NULL
, 0);
3263 /* Make all the standard events reach the Emacs frame. */
3264 attributes
.event_mask
= STANDARD_EVENT_SET
;
3265 attribute_mask
= CWEventMask
;
3266 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3267 attribute_mask
, &attributes
);
3269 XtMapWidget (frame_widget
);
3271 /* x_set_name normally ignores requests to set the name if the
3272 requested name is the same as the current name. This is the one
3273 place where that assumption isn't correct; f->name is set, but
3274 the X server hasn't been told. */
3277 int explicit = f
->explicit_name
;
3279 f
->explicit_name
= 0;
3282 x_set_name (f
, name
, explicit);
3285 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3286 f
->output_data
.x
->text_cursor
);
3290 /* This is a no-op, except under Motif. Make sure main areas are
3291 set to something reasonable, in case we get an error later. */
3292 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3295 #else /* not USE_X_TOOLKIT */
3297 /* Create and set up the X window for frame F. */
3304 XClassHint class_hints
;
3305 XSetWindowAttributes attributes
;
3306 unsigned long attribute_mask
;
3308 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3309 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3310 attributes
.bit_gravity
= StaticGravity
;
3311 attributes
.backing_store
= NotUseful
;
3312 attributes
.save_under
= True
;
3313 attributes
.event_mask
= STANDARD_EVENT_SET
;
3314 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3316 | CWBackingStore
| CWSaveUnder
3322 = XCreateWindow (FRAME_X_DISPLAY (f
),
3323 f
->output_data
.x
->parent_desc
,
3324 f
->output_data
.x
->left_pos
,
3325 f
->output_data
.x
->top_pos
,
3326 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3327 f
->output_data
.x
->border_width
,
3328 CopyFromParent
, /* depth */
3329 InputOutput
, /* class */
3330 FRAME_X_DISPLAY_INFO (f
)->visual
,
3331 attribute_mask
, &attributes
);
3333 #ifndef X_I18N_INHIBITED
3338 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3342 xic
= XCreateIC (xim
,
3343 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3344 XNClientWindow
, FRAME_X_WINDOW(f
),
3345 XNFocusWindow
, FRAME_X_WINDOW(f
),
3355 FRAME_XIM (f
) = xim
;
3356 FRAME_XIC (f
) = xic
;
3358 #else /* X_I18N_INHIBITED */
3361 #endif /* X_I18N_INHIBITED */
3362 #endif /* HAVE_X_I18N */
3364 validate_x_resource_name ();
3366 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3367 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3368 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3370 /* The menubar is part of the ordinary display;
3371 it does not count in addition to the height of the window. */
3372 f
->output_data
.x
->menubar_height
= 0;
3374 /* This indicates that we use the "Passive Input" input model.
3375 Unless we do this, we don't get the Focus{In,Out} events that we
3376 need to draw the cursor correctly. Accursed bureaucrats.
3377 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3379 f
->output_data
.x
->wm_hints
.input
= True
;
3380 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3381 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3382 &f
->output_data
.x
->wm_hints
);
3383 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3385 /* Request "save yourself" and "delete window" commands from wm. */
3388 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3389 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3390 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3393 /* x_set_name normally ignores requests to set the name if the
3394 requested name is the same as the current name. This is the one
3395 place where that assumption isn't correct; f->name is set, but
3396 the X server hasn't been told. */
3399 int explicit = f
->explicit_name
;
3401 f
->explicit_name
= 0;
3404 x_set_name (f
, name
, explicit);
3407 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3408 f
->output_data
.x
->text_cursor
);
3412 if (FRAME_X_WINDOW (f
) == 0)
3413 error ("Unable to create window");
3416 #endif /* not USE_X_TOOLKIT */
3418 /* Handle the icon stuff for this window. Perhaps later we might
3419 want an x_set_icon_position which can be called interactively as
3427 Lisp_Object icon_x
, icon_y
;
3428 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3430 /* Set the position of the icon. Note that twm groups all
3431 icons in an icon window. */
3432 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3433 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3434 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3436 CHECK_NUMBER (icon_x
, 0);
3437 CHECK_NUMBER (icon_y
, 0);
3439 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3440 error ("Both left and top icon corners of icon must be specified");
3444 if (! EQ (icon_x
, Qunbound
))
3445 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3447 /* Start up iconic or window? */
3448 x_wm_set_window_state
3449 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3454 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3461 /* Make the GC's needed for this window, setting the
3462 background, border and mouse colors; also create the
3463 mouse cursor and the gray border tile. */
3465 static char cursor_bits
[] =
3467 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3468 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3469 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3470 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3477 XGCValues gc_values
;
3481 /* Create the GC's of this frame.
3482 Note that many default values are used. */
3485 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3486 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3487 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3488 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3489 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3491 GCLineWidth
| GCFont
3492 | GCForeground
| GCBackground
,
3495 /* Reverse video style. */
3496 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3497 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3498 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3500 GCFont
| GCForeground
| GCBackground
3504 /* Cursor has cursor-color background, background-color foreground. */
3505 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3506 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3507 gc_values
.fill_style
= FillOpaqueStippled
;
3509 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3510 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3511 cursor_bits
, 16, 16);
3512 f
->output_data
.x
->cursor_gc
3513 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3514 (GCFont
| GCForeground
| GCBackground
3515 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3519 f
->output_data
.x
->white_relief
.gc
= 0;
3520 f
->output_data
.x
->black_relief
.gc
= 0;
3522 /* Create the gray border tile used when the pointer is not in
3523 the frame. Since this depends on the frame's pixel values,
3524 this must be done on a per-frame basis. */
3525 f
->output_data
.x
->border_tile
3526 = (XCreatePixmapFromBitmapData
3527 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3528 gray_bits
, gray_width
, gray_height
,
3529 f
->output_data
.x
->foreground_pixel
,
3530 f
->output_data
.x
->background_pixel
,
3531 DefaultDepth (FRAME_X_DISPLAY (f
),
3532 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3537 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3539 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3540 Returns an Emacs frame object.\n\
3541 ALIST is an alist of frame parameters.\n\
3542 If the parameters specify that the frame should not have a minibuffer,\n\
3543 and do not specify a specific minibuffer window to use,\n\
3544 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3545 be shared by the new frame.\n\
3547 This function is an internal primitive--use `make-frame' instead.")
3552 Lisp_Object frame
, tem
;
3554 int minibuffer_only
= 0;
3555 long window_prompting
= 0;
3557 int count
= specpdl_ptr
- specpdl
;
3558 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3559 Lisp_Object display
;
3560 struct x_display_info
*dpyinfo
= NULL
;
3566 /* Use this general default value to start with
3567 until we know if this frame has a specified name. */
3568 Vx_resource_name
= Vinvocation_name
;
3570 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3571 if (EQ (display
, Qunbound
))
3573 dpyinfo
= check_x_display_info (display
);
3575 kb
= dpyinfo
->kboard
;
3577 kb
= &the_only_kboard
;
3580 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3582 && ! EQ (name
, Qunbound
)
3584 error ("Invalid frame name--not a string or nil");
3587 Vx_resource_name
= name
;
3589 /* See if parent window is specified. */
3590 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3591 if (EQ (parent
, Qunbound
))
3593 if (! NILP (parent
))
3594 CHECK_NUMBER (parent
, 0);
3596 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3597 /* No need to protect DISPLAY because that's not used after passing
3598 it to make_frame_without_minibuffer. */
3600 GCPRO4 (parms
, parent
, name
, frame
);
3601 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3603 if (EQ (tem
, Qnone
) || NILP (tem
))
3604 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3605 else if (EQ (tem
, Qonly
))
3607 f
= make_minibuffer_frame ();
3608 minibuffer_only
= 1;
3610 else if (WINDOWP (tem
))
3611 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3615 XSETFRAME (frame
, f
);
3617 /* Note that X Windows does support scroll bars. */
3618 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3620 f
->output_method
= output_x_window
;
3621 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3622 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3623 f
->output_data
.x
->icon_bitmap
= -1;
3624 f
->output_data
.x
->fontset
= -1;
3625 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3626 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3629 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3631 if (! STRINGP (f
->icon_name
))
3632 f
->icon_name
= Qnil
;
3634 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3636 FRAME_KBOARD (f
) = kb
;
3639 /* Specify the parent under which to make this X window. */
3643 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3644 f
->output_data
.x
->explicit_parent
= 1;
3648 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3649 f
->output_data
.x
->explicit_parent
= 0;
3652 /* Set the name; the functions to which we pass f expect the name to
3654 if (EQ (name
, Qunbound
) || NILP (name
))
3656 f
->name
= build_string (dpyinfo
->x_id_name
);
3657 f
->explicit_name
= 0;
3662 f
->explicit_name
= 1;
3663 /* use the frame's title when getting resources for this frame. */
3664 specbind (Qx_resource_name
, name
);
3667 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3668 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3669 fs_register_fontset (f
, XCAR (tem
));
3671 /* Extract the window parameters from the supplied values
3672 that are needed to determine window geometry. */
3676 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3679 /* First, try whatever font the caller has specified. */
3682 tem
= Fquery_fontset (font
, Qnil
);
3684 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3686 font
= x_new_font (f
, XSTRING (font
)->data
);
3689 /* Try out a font which we hope has bold and italic variations. */
3690 if (!STRINGP (font
))
3691 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3692 if (!STRINGP (font
))
3693 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3694 if (! STRINGP (font
))
3695 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3696 if (! STRINGP (font
))
3697 /* This was formerly the first thing tried, but it finds too many fonts
3698 and takes too long. */
3699 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3700 /* If those didn't work, look for something which will at least work. */
3701 if (! STRINGP (font
))
3702 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3704 if (! STRINGP (font
))
3705 font
= build_string ("fixed");
3707 x_default_parameter (f
, parms
, Qfont
, font
,
3708 "font", "Font", RES_TYPE_STRING
);
3712 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3713 whereby it fails to get any font. */
3714 xlwmenu_default_font
= f
->output_data
.x
->font
;
3717 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3718 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3720 /* This defaults to 2 in order to match xterm. We recognize either
3721 internalBorderWidth or internalBorder (which is what xterm calls
3723 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3727 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3728 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3729 if (! EQ (value
, Qunbound
))
3730 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3733 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3734 "internalBorderWidth", "internalBorderWidth",
3736 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3737 "verticalScrollBars", "ScrollBars",
3740 /* Also do the stuff which must be set before the window exists. */
3741 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3742 "foreground", "Foreground", RES_TYPE_STRING
);
3743 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3744 "background", "Background", RES_TYPE_STRING
);
3745 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3746 "pointerColor", "Foreground", RES_TYPE_STRING
);
3747 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3748 "cursorColor", "Foreground", RES_TYPE_STRING
);
3749 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3750 "borderColor", "BorderColor", RES_TYPE_STRING
);
3751 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3752 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3754 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3755 "scrollBarForeground",
3756 "ScrollBarForeground", 1);
3757 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3758 "scrollBarBackground",
3759 "ScrollBarBackground", 0);
3761 /* Init faces before x_default_parameter is called for scroll-bar
3762 parameters because that function calls x_set_scroll_bar_width,
3763 which calls change_frame_size, which calls Fset_window_buffer,
3764 which runs hooks, which call Fvertical_motion. At the end, we
3765 end up in init_iterator with a null face cache, which should not
3767 init_frame_faces (f
);
3769 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3770 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3771 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3772 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3773 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3774 "scrollBarWidth", "ScrollBarWidth",
3776 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3777 "bufferPredicate", "BufferPredicate",
3779 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3780 "title", "Title", RES_TYPE_STRING
);
3782 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3783 window_prompting
= x_figure_window_size (f
, parms
);
3785 if (window_prompting
& XNegative
)
3787 if (window_prompting
& YNegative
)
3788 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3790 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3794 if (window_prompting
& YNegative
)
3795 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3797 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3800 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3802 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3803 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3805 /* Create the X widget or window. Add the tool-bar height to the
3806 initial frame height so that the user gets a text display area of
3807 the size he specified with -g or via .Xdefaults. Later changes
3808 of the tool-bar height don't change the frame size. This is done
3809 so that users can create tall Emacs frames without having to
3810 guess how tall the tool-bar will get. */
3811 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3813 #ifdef USE_X_TOOLKIT
3814 x_window (f
, window_prompting
, minibuffer_only
);
3822 /* Now consider the frame official. */
3823 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3824 Vframe_list
= Fcons (frame
, Vframe_list
);
3826 /* We need to do this after creating the X window, so that the
3827 icon-creation functions can say whose icon they're describing. */
3828 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3829 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3831 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3832 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3833 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3834 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3835 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3836 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3838 /* Dimensions, especially f->height, must be done via change_frame_size.
3839 Change will not be effected unless different from the current
3844 SET_FRAME_WIDTH (f
, 0);
3845 change_frame_size (f
, height
, width
, 1, 0, 0);
3847 /* Set up faces after all frame parameters are known. */
3848 call1 (Qface_set_after_frame_default
, frame
);
3850 #ifdef USE_X_TOOLKIT
3851 /* Create the menu bar. */
3852 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3854 /* If this signals an error, we haven't set size hints for the
3855 frame and we didn't make it visible. */
3856 initialize_frame_menubar (f
);
3858 /* This is a no-op, except under Motif where it arranges the
3859 main window for the widgets on it. */
3860 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3861 f
->output_data
.x
->menubar_widget
,
3862 f
->output_data
.x
->edit_widget
);
3864 #endif /* USE_X_TOOLKIT */
3866 /* Tell the server what size and position, etc, we want, and how
3867 badly we want them. This should be done after we have the menu
3868 bar so that its size can be taken into account. */
3870 x_wm_set_size_hint (f
, window_prompting
, 0);
3873 /* Make the window appear on the frame and enable display, unless
3874 the caller says not to. However, with explicit parent, Emacs
3875 cannot control visibility, so don't try. */
3876 if (! f
->output_data
.x
->explicit_parent
)
3878 Lisp_Object visibility
;
3880 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3882 if (EQ (visibility
, Qunbound
))
3885 if (EQ (visibility
, Qicon
))
3886 x_iconify_frame (f
);
3887 else if (! NILP (visibility
))
3888 x_make_frame_visible (f
);
3890 /* Must have been Qnil. */
3895 return unbind_to (count
, frame
);
3898 /* FRAME is used only to get a handle on the X display. We don't pass the
3899 display info directly because we're called from frame.c, which doesn't
3900 know about that structure. */
3903 x_get_focus_frame (frame
)
3904 struct frame
*frame
;
3906 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3908 if (! dpyinfo
->x_focus_frame
)
3911 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3916 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3917 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3918 If FRAME is omitted or nil, use the selected frame.")
3920 Lisp_Object color
, frame
;
3923 FRAME_PTR f
= check_x_frame (frame
);
3925 CHECK_STRING (color
, 1);
3927 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3933 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3934 "Return a description of the color named COLOR on frame FRAME.\n\
3935 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3936 These values appear to range from 0 to 65280 or 65535, depending\n\
3937 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3938 If FRAME is omitted or nil, use the selected frame.")
3940 Lisp_Object color
, frame
;
3943 FRAME_PTR f
= check_x_frame (frame
);
3945 CHECK_STRING (color
, 1);
3947 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3951 rgb
[0] = make_number (foo
.red
);
3952 rgb
[1] = make_number (foo
.green
);
3953 rgb
[2] = make_number (foo
.blue
);
3954 return Flist (3, rgb
);
3960 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3961 "Return t if the X display supports color.\n\
3962 The optional argument DISPLAY specifies which display to ask about.\n\
3963 DISPLAY should be either a frame or a display name (a string).\n\
3964 If omitted or nil, that stands for the selected frame's display.")
3966 Lisp_Object display
;
3968 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3970 if (dpyinfo
->n_planes
<= 2)
3973 switch (dpyinfo
->visual
->class)
3986 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3988 "Return t if the X display supports shades of gray.\n\
3989 Note that color displays do support shades of gray.\n\
3990 The optional argument DISPLAY specifies which display to ask about.\n\
3991 DISPLAY should be either a frame or a display name (a string).\n\
3992 If omitted or nil, that stands for the selected frame's display.")
3994 Lisp_Object display
;
3996 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3998 if (dpyinfo
->n_planes
<= 1)
4001 switch (dpyinfo
->visual
->class)
4016 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4018 "Returns the width in pixels of the X display DISPLAY.\n\
4019 The optional argument DISPLAY specifies which display to ask about.\n\
4020 DISPLAY should be either a frame or a display name (a string).\n\
4021 If omitted or nil, that stands for the selected frame's display.")
4023 Lisp_Object display
;
4025 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4027 return make_number (dpyinfo
->width
);
4030 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4031 Sx_display_pixel_height
, 0, 1, 0,
4032 "Returns the height in pixels of the X display DISPLAY.\n\
4033 The optional argument DISPLAY specifies which display to ask about.\n\
4034 DISPLAY should be either a frame or a display name (a string).\n\
4035 If omitted or nil, that stands for the selected frame's display.")
4037 Lisp_Object display
;
4039 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4041 return make_number (dpyinfo
->height
);
4044 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4046 "Returns the number of bitplanes of the X display DISPLAY.\n\
4047 The optional argument DISPLAY specifies which display to ask about.\n\
4048 DISPLAY should be either a frame or a display name (a string).\n\
4049 If omitted or nil, that stands for the selected frame's display.")
4051 Lisp_Object display
;
4053 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4055 return make_number (dpyinfo
->n_planes
);
4058 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4060 "Returns the number of color cells of the X display DISPLAY.\n\
4061 The optional argument DISPLAY specifies which display to ask about.\n\
4062 DISPLAY should be either a frame or a display name (a string).\n\
4063 If omitted or nil, that stands for the selected frame's display.")
4065 Lisp_Object display
;
4067 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4069 return make_number (DisplayCells (dpyinfo
->display
,
4070 XScreenNumberOfScreen (dpyinfo
->screen
)));
4073 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4074 Sx_server_max_request_size
,
4076 "Returns the maximum request size of the X server of display DISPLAY.\n\
4077 The optional argument DISPLAY specifies which display to ask about.\n\
4078 DISPLAY should be either a frame or a display name (a string).\n\
4079 If omitted or nil, that stands for the selected frame's display.")
4081 Lisp_Object display
;
4083 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4085 return make_number (MAXREQUEST (dpyinfo
->display
));
4088 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4089 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4090 The optional argument DISPLAY specifies which display to ask about.\n\
4091 DISPLAY should be either a frame or a display name (a string).\n\
4092 If omitted or nil, that stands for the selected frame's display.")
4094 Lisp_Object display
;
4096 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4097 char *vendor
= ServerVendor (dpyinfo
->display
);
4099 if (! vendor
) vendor
= "";
4100 return build_string (vendor
);
4103 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4104 "Returns the version numbers of the X server of display DISPLAY.\n\
4105 The value is a list of three integers: the major and minor\n\
4106 version numbers of the X Protocol in use, and the vendor-specific release\n\
4107 number. See also the function `x-server-vendor'.\n\n\
4108 The optional argument DISPLAY specifies which display to ask about.\n\
4109 DISPLAY should be either a frame or a display name (a string).\n\
4110 If omitted or nil, that stands for the selected frame's display.")
4112 Lisp_Object display
;
4114 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4115 Display
*dpy
= dpyinfo
->display
;
4117 return Fcons (make_number (ProtocolVersion (dpy
)),
4118 Fcons (make_number (ProtocolRevision (dpy
)),
4119 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4122 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4123 "Returns the number of screens on the X server of display DISPLAY.\n\
4124 The optional argument DISPLAY specifies which display to ask about.\n\
4125 DISPLAY should be either a frame or a display name (a string).\n\
4126 If omitted or nil, that stands for the selected frame's display.")
4128 Lisp_Object display
;
4130 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4132 return make_number (ScreenCount (dpyinfo
->display
));
4135 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4136 "Returns the height in millimeters of the X display DISPLAY.\n\
4137 The optional argument DISPLAY specifies which display to ask about.\n\
4138 DISPLAY should be either a frame or a display name (a string).\n\
4139 If omitted or nil, that stands for the selected frame's display.")
4141 Lisp_Object display
;
4143 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4145 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4148 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4149 "Returns the width in millimeters of the X display DISPLAY.\n\
4150 The optional argument DISPLAY specifies which display to ask about.\n\
4151 DISPLAY should be either a frame or a display name (a string).\n\
4152 If omitted or nil, that stands for the selected frame's display.")
4154 Lisp_Object display
;
4156 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4158 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4161 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4162 Sx_display_backing_store
, 0, 1, 0,
4163 "Returns an indication of whether X display DISPLAY does backing store.\n\
4164 The value may be `always', `when-mapped', or `not-useful'.\n\
4165 The optional argument DISPLAY specifies which display to ask about.\n\
4166 DISPLAY should be either a frame or a display name (a string).\n\
4167 If omitted or nil, that stands for the selected frame's display.")
4169 Lisp_Object display
;
4171 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4173 switch (DoesBackingStore (dpyinfo
->screen
))
4176 return intern ("always");
4179 return intern ("when-mapped");
4182 return intern ("not-useful");
4185 error ("Strange value for BackingStore parameter of screen");
4189 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4190 Sx_display_visual_class
, 0, 1, 0,
4191 "Returns the visual class of the X display DISPLAY.\n\
4192 The value is one of the symbols `static-gray', `gray-scale',\n\
4193 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4194 The optional argument DISPLAY specifies which display to ask about.\n\
4195 DISPLAY should be either a frame or a display name (a string).\n\
4196 If omitted or nil, that stands for the selected frame's display.")
4198 Lisp_Object display
;
4200 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4202 switch (dpyinfo
->visual
->class)
4204 case StaticGray
: return (intern ("static-gray"));
4205 case GrayScale
: return (intern ("gray-scale"));
4206 case StaticColor
: return (intern ("static-color"));
4207 case PseudoColor
: return (intern ("pseudo-color"));
4208 case TrueColor
: return (intern ("true-color"));
4209 case DirectColor
: return (intern ("direct-color"));
4211 error ("Display has an unknown visual class");
4215 DEFUN ("x-display-save-under", Fx_display_save_under
,
4216 Sx_display_save_under
, 0, 1, 0,
4217 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4218 The optional argument DISPLAY specifies which display to ask about.\n\
4219 DISPLAY should be either a frame or a display name (a string).\n\
4220 If omitted or nil, that stands for the selected frame's display.")
4222 Lisp_Object display
;
4224 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4226 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4234 register struct frame
*f
;
4236 return PIXEL_WIDTH (f
);
4241 register struct frame
*f
;
4243 return PIXEL_HEIGHT (f
);
4248 register struct frame
*f
;
4250 return FONT_WIDTH (f
->output_data
.x
->font
);
4255 register struct frame
*f
;
4257 return f
->output_data
.x
->line_height
;
4262 register struct frame
*f
;
4264 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4267 #if 0 /* These no longer seem like the right way to do things. */
4269 /* Draw a rectangle on the frame with left top corner including
4270 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4271 CHARS by LINES wide and long and is the color of the cursor. */
4274 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4275 register struct frame
*f
;
4277 register int top_char
, left_char
, chars
, lines
;
4281 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4282 + f
->output_data
.x
->internal_border_width
);
4283 int top
= (top_char
* f
->output_data
.x
->line_height
4284 + f
->output_data
.x
->internal_border_width
);
4287 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4289 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4291 height
= f
->output_data
.x
->line_height
/ 2;
4293 height
= f
->output_data
.x
->line_height
* lines
;
4295 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4296 gc
, left
, top
, width
, height
);
4299 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4300 "Draw a rectangle on FRAME between coordinates specified by\n\
4301 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4302 (frame
, X0
, Y0
, X1
, Y1
)
4303 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4305 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4307 CHECK_LIVE_FRAME (frame
, 0);
4308 CHECK_NUMBER (X0
, 0);
4309 CHECK_NUMBER (Y0
, 1);
4310 CHECK_NUMBER (X1
, 2);
4311 CHECK_NUMBER (Y1
, 3);
4321 n_lines
= y1
- y0
+ 1;
4326 n_lines
= y0
- y1
+ 1;
4332 n_chars
= x1
- x0
+ 1;
4337 n_chars
= x0
- x1
+ 1;
4341 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4342 left
, top
, n_chars
, n_lines
);
4348 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4349 "Draw a rectangle drawn on FRAME between coordinates\n\
4350 X0, Y0, X1, Y1 in the regular background-pixel.")
4351 (frame
, X0
, Y0
, X1
, Y1
)
4352 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4354 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4356 CHECK_LIVE_FRAME (frame
, 0);
4357 CHECK_NUMBER (X0
, 0);
4358 CHECK_NUMBER (Y0
, 1);
4359 CHECK_NUMBER (X1
, 2);
4360 CHECK_NUMBER (Y1
, 3);
4370 n_lines
= y1
- y0
+ 1;
4375 n_lines
= y0
- y1
+ 1;
4381 n_chars
= x1
- x0
+ 1;
4386 n_chars
= x0
- x1
+ 1;
4390 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4391 left
, top
, n_chars
, n_lines
);
4397 /* Draw lines around the text region beginning at the character position
4398 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4399 pixel and line characteristics. */
4401 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4404 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4405 register struct frame
*f
;
4407 int top_x
, top_y
, bottom_x
, bottom_y
;
4409 register int ibw
= f
->output_data
.x
->internal_border_width
;
4410 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4411 register int font_h
= f
->output_data
.x
->line_height
;
4413 int x
= line_len (y
);
4414 XPoint
*pixel_points
4415 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4416 register XPoint
*this_point
= pixel_points
;
4418 /* Do the horizontal top line/lines */
4421 this_point
->x
= ibw
;
4422 this_point
->y
= ibw
+ (font_h
* top_y
);
4425 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4427 this_point
->x
= ibw
+ (font_w
* x
);
4428 this_point
->y
= (this_point
- 1)->y
;
4432 this_point
->x
= ibw
;
4433 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4435 this_point
->x
= ibw
+ (font_w
* top_x
);
4436 this_point
->y
= (this_point
- 1)->y
;
4438 this_point
->x
= (this_point
- 1)->x
;
4439 this_point
->y
= ibw
+ (font_h
* top_y
);
4441 this_point
->x
= ibw
+ (font_w
* x
);
4442 this_point
->y
= (this_point
- 1)->y
;
4445 /* Now do the right side. */
4446 while (y
< bottom_y
)
4447 { /* Right vertical edge */
4449 this_point
->x
= (this_point
- 1)->x
;
4450 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4453 y
++; /* Horizontal connection to next line */
4456 this_point
->x
= ibw
+ (font_w
/ 2);
4458 this_point
->x
= ibw
+ (font_w
* x
);
4460 this_point
->y
= (this_point
- 1)->y
;
4463 /* Now do the bottom and connect to the top left point. */
4464 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4467 this_point
->x
= (this_point
- 1)->x
;
4468 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4470 this_point
->x
= ibw
;
4471 this_point
->y
= (this_point
- 1)->y
;
4473 this_point
->x
= pixel_points
->x
;
4474 this_point
->y
= pixel_points
->y
;
4476 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4478 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4481 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4482 "Highlight the region between point and the character under the mouse\n\
4485 register Lisp_Object event
;
4487 register int x0
, y0
, x1
, y1
;
4488 register struct frame
*f
= selected_frame
;
4489 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4490 register int p1
, p2
;
4492 CHECK_CONS (event
, 0);
4495 x0
= XINT (Fcar (Fcar (event
)));
4496 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4498 /* If the mouse is past the end of the line, don't that area. */
4499 /* ReWrite this... */
4501 /* Where the cursor is. */
4502 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4503 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4505 if (y1
> y0
) /* point below mouse */
4506 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4508 else if (y1
< y0
) /* point above mouse */
4509 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4511 else /* same line: draw horizontal rectangle */
4514 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4515 x0
, y0
, (x1
- x0
+ 1), 1);
4517 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4518 x1
, y1
, (x0
- x1
+ 1), 1);
4521 XFlush (FRAME_X_DISPLAY (f
));
4527 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4528 "Erase any highlighting of the region between point and the character\n\
4529 at X, Y on the selected frame.")
4531 register Lisp_Object event
;
4533 register int x0
, y0
, x1
, y1
;
4534 register struct frame
*f
= selected_frame
;
4535 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4538 x0
= XINT (Fcar (Fcar (event
)));
4539 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4540 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4541 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4543 if (y1
> y0
) /* point below mouse */
4544 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4546 else if (y1
< y0
) /* point above mouse */
4547 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4549 else /* same line: draw horizontal rectangle */
4552 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4553 x0
, y0
, (x1
- x0
+ 1), 1);
4555 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4556 x1
, y1
, (x0
- x1
+ 1), 1);
4564 int contour_begin_x
, contour_begin_y
;
4565 int contour_end_x
, contour_end_y
;
4566 int contour_npoints
;
4568 /* Clip the top part of the contour lines down (and including) line Y_POS.
4569 If X_POS is in the middle (rather than at the end) of the line, drop
4570 down a line at that character. */
4573 clip_contour_top (y_pos
, x_pos
)
4575 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4576 register XPoint
*end
;
4577 register int npoints
;
4578 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4580 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4582 end
= contour_lines
[y_pos
].top_right
;
4583 npoints
= (end
- begin
+ 1);
4584 XDrawLines (x_current_display
, contour_window
,
4585 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4587 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4588 contour_last_point
-= (npoints
- 2);
4589 XDrawLines (x_current_display
, contour_window
,
4590 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4591 XFlush (x_current_display
);
4593 /* Now, update contour_lines structure. */
4598 register XPoint
*p
= begin
+ 1;
4599 end
= contour_lines
[y_pos
].bottom_right
;
4600 npoints
= (end
- begin
+ 1);
4601 XDrawLines (x_current_display
, contour_window
,
4602 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4605 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4607 p
->y
= begin
->y
+ font_h
;
4609 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4610 contour_last_point
-= (npoints
- 5);
4611 XDrawLines (x_current_display
, contour_window
,
4612 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4613 XFlush (x_current_display
);
4615 /* Now, update contour_lines structure. */
4619 /* Erase the top horizontal lines of the contour, and then extend
4620 the contour upwards. */
4623 extend_contour_top (line
)
4628 clip_contour_bottom (x_pos
, y_pos
)
4634 extend_contour_bottom (x_pos
, y_pos
)
4638 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4643 register struct frame
*f
= selected_frame
;
4644 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4645 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4646 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4647 register int mouse_below_point
;
4648 register Lisp_Object obj
;
4649 register int x_contour_x
, x_contour_y
;
4651 x_contour_x
= x_mouse_x
;
4652 x_contour_y
= x_mouse_y
;
4653 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4654 && x_contour_x
> point_x
))
4656 mouse_below_point
= 1;
4657 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4658 x_contour_x
, x_contour_y
);
4662 mouse_below_point
= 0;
4663 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4669 obj
= read_char (-1, 0, 0, Qnil
, 0);
4673 if (mouse_below_point
)
4675 if (x_mouse_y
<= point_y
) /* Flipped. */
4677 mouse_below_point
= 0;
4679 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4680 x_contour_x
, x_contour_y
);
4681 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4684 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4686 clip_contour_bottom (x_mouse_y
);
4688 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4690 extend_bottom_contour (x_mouse_y
);
4693 x_contour_x
= x_mouse_x
;
4694 x_contour_y
= x_mouse_y
;
4696 else /* mouse above or same line as point */
4698 if (x_mouse_y
>= point_y
) /* Flipped. */
4700 mouse_below_point
= 1;
4702 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4703 x_contour_x
, x_contour_y
, point_x
, point_y
);
4704 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4705 x_mouse_x
, x_mouse_y
);
4707 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4709 clip_contour_top (x_mouse_y
);
4711 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4713 extend_contour_top (x_mouse_y
);
4718 unread_command_event
= obj
;
4719 if (mouse_below_point
)
4721 contour_begin_x
= point_x
;
4722 contour_begin_y
= point_y
;
4723 contour_end_x
= x_contour_x
;
4724 contour_end_y
= x_contour_y
;
4728 contour_begin_x
= x_contour_x
;
4729 contour_begin_y
= x_contour_y
;
4730 contour_end_x
= point_x
;
4731 contour_end_y
= point_y
;
4736 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4741 register Lisp_Object obj
;
4742 struct frame
*f
= selected_frame
;
4743 register struct window
*w
= XWINDOW (selected_window
);
4744 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4745 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4747 char dash_list
[] = {6, 4, 6, 4};
4749 XGCValues gc_values
;
4751 register int previous_y
;
4752 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4753 + f
->output_data
.x
->internal_border_width
;
4754 register int left
= f
->output_data
.x
->internal_border_width
4755 + (WINDOW_LEFT_MARGIN (w
)
4756 * FONT_WIDTH (f
->output_data
.x
->font
));
4757 register int right
= left
+ (w
->width
4758 * FONT_WIDTH (f
->output_data
.x
->font
))
4759 - f
->output_data
.x
->internal_border_width
;
4763 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4764 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4765 gc_values
.line_width
= 1;
4766 gc_values
.line_style
= LineOnOffDash
;
4767 gc_values
.cap_style
= CapRound
;
4768 gc_values
.join_style
= JoinRound
;
4770 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4771 GCLineStyle
| GCJoinStyle
| GCCapStyle
4772 | GCLineWidth
| GCForeground
| GCBackground
,
4774 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4775 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4776 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4777 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4778 GCLineStyle
| GCJoinStyle
| GCCapStyle
4779 | GCLineWidth
| GCForeground
| GCBackground
,
4781 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4788 if (x_mouse_y
>= XINT (w
->top
)
4789 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4791 previous_y
= x_mouse_y
;
4792 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4793 + f
->output_data
.x
->internal_border_width
;
4794 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4795 line_gc
, left
, line
, right
, line
);
4797 XFlush (FRAME_X_DISPLAY (f
));
4802 obj
= read_char (-1, 0, 0, Qnil
, 0);
4804 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4805 Qvertical_scroll_bar
))
4809 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4810 erase_gc
, left
, line
, right
, line
);
4811 unread_command_event
= obj
;
4813 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4814 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4820 while (x_mouse_y
== previous_y
);
4823 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4824 erase_gc
, left
, line
, right
, line
);
4831 /* These keep track of the rectangle following the pointer. */
4832 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4834 /* Offset in buffer of character under the pointer, or 0. */
4835 int mouse_buffer_offset
;
4837 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4838 "Track the pointer.")
4841 static Cursor current_pointer_shape
;
4842 FRAME_PTR f
= x_mouse_frame
;
4845 if (EQ (Vmouse_frame_part
, Qtext_part
)
4846 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4851 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4852 XDefineCursor (FRAME_X_DISPLAY (f
),
4854 current_pointer_shape
);
4856 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4857 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4859 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4860 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4862 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4863 XDefineCursor (FRAME_X_DISPLAY (f
),
4865 current_pointer_shape
);
4868 XFlush (FRAME_X_DISPLAY (f
));
4874 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4875 "Draw rectangle around character under mouse pointer, if there is one.")
4879 struct window
*w
= XWINDOW (Vmouse_window
);
4880 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4881 struct buffer
*b
= XBUFFER (w
->buffer
);
4884 if (! EQ (Vmouse_window
, selected_window
))
4887 if (EQ (event
, Qnil
))
4891 x_read_mouse_position (selected_frame
, &x
, &y
);
4895 mouse_track_width
= 0;
4896 mouse_track_left
= mouse_track_top
= -1;
4900 if ((x_mouse_x
!= mouse_track_left
4901 && (x_mouse_x
< mouse_track_left
4902 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4903 || x_mouse_y
!= mouse_track_top
)
4905 int hp
= 0; /* Horizontal position */
4906 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4907 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4908 int tab_width
= XINT (b
->tab_width
);
4909 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4911 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4912 int in_mode_line
= 0;
4914 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4917 /* Erase previous rectangle. */
4918 if (mouse_track_width
)
4920 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4921 mouse_track_left
, mouse_track_top
,
4922 mouse_track_width
, 1);
4924 if ((mouse_track_left
== f
->phys_cursor_x
4925 || mouse_track_left
== f
->phys_cursor_x
- 1)
4926 && mouse_track_top
== f
->phys_cursor_y
)
4928 x_display_cursor (f
, 1);
4932 mouse_track_left
= x_mouse_x
;
4933 mouse_track_top
= x_mouse_y
;
4934 mouse_track_width
= 0;
4936 if (mouse_track_left
> len
) /* Past the end of line. */
4939 if (mouse_track_top
== mode_line_vpos
)
4945 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4949 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4955 mouse_track_width
= tab_width
- (hp
% tab_width
);
4957 hp
+= mouse_track_width
;
4960 mouse_track_left
= hp
- mouse_track_width
;
4966 mouse_track_width
= -1;
4970 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4975 mouse_track_width
= 2;
4980 mouse_track_left
= hp
- mouse_track_width
;
4986 mouse_track_width
= 1;
4993 while (hp
<= x_mouse_x
);
4996 if (mouse_track_width
) /* Over text; use text pointer shape. */
4998 XDefineCursor (FRAME_X_DISPLAY (f
),
5000 f
->output_data
.x
->text_cursor
);
5001 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
5002 mouse_track_left
, mouse_track_top
,
5003 mouse_track_width
, 1);
5005 else if (in_mode_line
)
5006 XDefineCursor (FRAME_X_DISPLAY (f
),
5008 f
->output_data
.x
->modeline_cursor
);
5010 XDefineCursor (FRAME_X_DISPLAY (f
),
5012 f
->output_data
.x
->nontext_cursor
);
5015 XFlush (FRAME_X_DISPLAY (f
));
5018 obj
= read_char (-1, 0, 0, Qnil
, 0);
5021 while (CONSP (obj
) /* Mouse event */
5022 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5023 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5024 && EQ (Vmouse_window
, selected_window
) /* In this window */
5027 unread_command_event
= obj
;
5029 if (mouse_track_width
)
5031 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5032 mouse_track_left
, mouse_track_top
,
5033 mouse_track_width
, 1);
5034 mouse_track_width
= 0;
5035 if ((mouse_track_left
== f
->phys_cursor_x
5036 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5037 && mouse_track_top
== f
->phys_cursor_y
)
5039 x_display_cursor (f
, 1);
5042 XDefineCursor (FRAME_X_DISPLAY (f
),
5044 f
->output_data
.x
->nontext_cursor
);
5045 XFlush (FRAME_X_DISPLAY (f
));
5055 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5056 on the frame F at position X, Y. */
5058 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5060 int x
, y
, width
, height
;
5065 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5066 FRAME_X_WINDOW (f
), image_data
,
5068 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5069 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5073 #if 0 /* I'm told these functions are superfluous
5074 given the ability to bind function keys. */
5077 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5078 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5079 KEYSYM is a string which conforms to the X keysym definitions found\n\
5080 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5081 list of strings specifying modifier keys such as Control_L, which must\n\
5082 also be depressed for NEWSTRING to appear.")
5083 (x_keysym
, modifiers
, newstring
)
5084 register Lisp_Object x_keysym
;
5085 register Lisp_Object modifiers
;
5086 register Lisp_Object newstring
;
5089 register KeySym keysym
;
5090 KeySym modifier_list
[16];
5093 CHECK_STRING (x_keysym
, 1);
5094 CHECK_STRING (newstring
, 3);
5096 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5097 if (keysym
== NoSymbol
)
5098 error ("Keysym does not exist");
5100 if (NILP (modifiers
))
5101 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5102 XSTRING (newstring
)->data
,
5103 STRING_BYTES (XSTRING (newstring
)));
5106 register Lisp_Object rest
, mod
;
5109 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5112 error ("Can't have more than 16 modifiers");
5115 CHECK_STRING (mod
, 3);
5116 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5118 if (modifier_list
[i
] == NoSymbol
5119 || !(IsModifierKey (modifier_list
[i
])
5120 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5121 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5123 if (modifier_list
[i
] == NoSymbol
5124 || !IsModifierKey (modifier_list
[i
]))
5126 error ("Element is not a modifier keysym");
5130 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5131 XSTRING (newstring
)->data
,
5132 STRING_BYTES (XSTRING (newstring
)));
5138 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5139 "Rebind KEYCODE to list of strings STRINGS.\n\
5140 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5141 nil as element means don't change.\n\
5142 See the documentation of `x-rebind-key' for more information.")
5144 register Lisp_Object keycode
;
5145 register Lisp_Object strings
;
5147 register Lisp_Object item
;
5148 register unsigned char *rawstring
;
5149 KeySym rawkey
, modifier
[1];
5151 register unsigned i
;
5154 CHECK_NUMBER (keycode
, 1);
5155 CHECK_CONS (strings
, 2);
5156 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5157 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5159 item
= Fcar (strings
);
5162 CHECK_STRING (item
, 2);
5163 strsize
= STRING_BYTES (XSTRING (item
));
5164 rawstring
= (unsigned char *) xmalloc (strsize
);
5165 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5166 modifier
[1] = 1 << i
;
5167 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5168 rawstring
, strsize
);
5173 #endif /* HAVE_X11 */
5176 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5178 XScreenNumberOfScreen (scr
)
5179 register Screen
*scr
;
5181 register Display
*dpy
;
5182 register Screen
*dpyscr
;
5186 dpyscr
= dpy
->screens
;
5188 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5194 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5197 select_visual (dpy
, screen
, depth
)
5200 unsigned int *depth
;
5203 XVisualInfo
*vinfo
, vinfo_template
;
5206 v
= DefaultVisualOfScreen (screen
);
5209 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5211 vinfo_template
.visualid
= v
->visualid
;
5214 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5216 vinfo
= XGetVisualInfo (dpy
,
5217 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5220 fatal ("Can't get proper X visual info");
5222 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5223 *depth
= vinfo
->depth
;
5227 int n
= vinfo
->colormap_size
- 1;
5236 XFree ((char *) vinfo
);
5240 /* Return the X display structure for the display named NAME.
5241 Open a new connection if necessary. */
5243 struct x_display_info
*
5244 x_display_info_for_name (name
)
5248 struct x_display_info
*dpyinfo
;
5250 CHECK_STRING (name
, 0);
5252 if (! EQ (Vwindow_system
, intern ("x")))
5253 error ("Not using X Windows");
5255 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5257 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5260 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5265 /* Use this general default value to start with. */
5266 Vx_resource_name
= Vinvocation_name
;
5268 validate_x_resource_name ();
5270 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5271 (char *) XSTRING (Vx_resource_name
)->data
);
5274 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5277 XSETFASTINT (Vwindow_system_version
, 11);
5282 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5283 1, 3, 0, "Open a connection to an X server.\n\
5284 DISPLAY is the name of the display to connect to.\n\
5285 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5286 If the optional third arg MUST-SUCCEED is non-nil,\n\
5287 terminate Emacs if we can't open the connection.")
5288 (display
, xrm_string
, must_succeed
)
5289 Lisp_Object display
, xrm_string
, must_succeed
;
5291 unsigned char *xrm_option
;
5292 struct x_display_info
*dpyinfo
;
5294 CHECK_STRING (display
, 0);
5295 if (! NILP (xrm_string
))
5296 CHECK_STRING (xrm_string
, 1);
5298 if (! EQ (Vwindow_system
, intern ("x")))
5299 error ("Not using X Windows");
5301 if (! NILP (xrm_string
))
5302 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5304 xrm_option
= (unsigned char *) 0;
5306 validate_x_resource_name ();
5308 /* This is what opens the connection and sets x_current_display.
5309 This also initializes many symbols, such as those used for input. */
5310 dpyinfo
= x_term_init (display
, xrm_option
,
5311 (char *) XSTRING (Vx_resource_name
)->data
);
5315 if (!NILP (must_succeed
))
5316 fatal ("Cannot connect to X server %s.\n\
5317 Check the DISPLAY environment variable or use `-d'.\n\
5318 Also use the `xhost' program to verify that it is set to permit\n\
5319 connections from your machine.\n",
5320 XSTRING (display
)->data
);
5322 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5327 XSETFASTINT (Vwindow_system_version
, 11);
5331 DEFUN ("x-close-connection", Fx_close_connection
,
5332 Sx_close_connection
, 1, 1, 0,
5333 "Close the connection to DISPLAY's X server.\n\
5334 For DISPLAY, specify either a frame or a display name (a string).\n\
5335 If DISPLAY is nil, that stands for the selected frame's display.")
5337 Lisp_Object display
;
5339 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5342 if (dpyinfo
->reference_count
> 0)
5343 error ("Display still has frames on it");
5346 /* Free the fonts in the font table. */
5347 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5348 if (dpyinfo
->font_table
[i
].name
)
5350 xfree (dpyinfo
->font_table
[i
].name
);
5351 /* Don't free the full_name string;
5352 it is always shared with something else. */
5353 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5356 x_destroy_all_bitmaps (dpyinfo
);
5357 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5359 #ifdef USE_X_TOOLKIT
5360 XtCloseDisplay (dpyinfo
->display
);
5362 XCloseDisplay (dpyinfo
->display
);
5365 x_delete_display (dpyinfo
);
5371 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5372 "Return the list of display names that Emacs has connections to.")
5375 Lisp_Object tail
, result
;
5378 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5379 result
= Fcons (XCAR (XCAR (tail
)), result
);
5384 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5385 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5386 If ON is nil, allow buffering of requests.\n\
5387 Turning on synchronization prohibits the Xlib routines from buffering\n\
5388 requests and seriously degrades performance, but makes debugging much\n\
5390 The optional second argument DISPLAY specifies which display to act on.\n\
5391 DISPLAY should be either a frame or a display name (a string).\n\
5392 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5394 Lisp_Object display
, on
;
5396 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5398 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5403 /* Wait for responses to all X commands issued so far for frame F. */
5410 XSync (FRAME_X_DISPLAY (f
), False
);
5415 /***********************************************************************
5417 ***********************************************************************/
5419 /* Value is the number of elements of vector VECTOR. */
5421 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5423 /* List of supported image types. Use define_image_type to add new
5424 types. Use lookup_image_type to find a type for a given symbol. */
5426 static struct image_type
*image_types
;
5428 /* A list of symbols, one for each supported image type. */
5430 Lisp_Object Vimage_types
;
5432 /* The symbol `image' which is the car of the lists used to represent
5435 extern Lisp_Object Qimage
;
5437 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5443 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5444 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5445 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5446 Lisp_Object QCindex
;
5448 /* Other symbols. */
5450 Lisp_Object Qlaplace
;
5452 /* Time in seconds after which images should be removed from the cache
5453 if not displayed. */
5455 Lisp_Object Vimage_cache_eviction_delay
;
5457 /* Function prototypes. */
5459 static void define_image_type
P_ ((struct image_type
*type
));
5460 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5461 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5462 static void x_laplace
P_ ((struct frame
*, struct image
*));
5463 static int x_build_heuristic_mask
P_ ((struct frame
*, Lisp_Object
,
5464 struct image
*, Lisp_Object
));
5467 /* Define a new image type from TYPE. This adds a copy of TYPE to
5468 image_types and adds the symbol *TYPE->type to Vimage_types. */
5471 define_image_type (type
)
5472 struct image_type
*type
;
5474 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5475 The initialized data segment is read-only. */
5476 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5477 bcopy (type
, p
, sizeof *p
);
5478 p
->next
= image_types
;
5480 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5484 /* Look up image type SYMBOL, and return a pointer to its image_type
5485 structure. Value is null if SYMBOL is not a known image type. */
5487 static INLINE
struct image_type
*
5488 lookup_image_type (symbol
)
5491 struct image_type
*type
;
5493 for (type
= image_types
; type
; type
= type
->next
)
5494 if (EQ (symbol
, *type
->type
))
5501 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5502 valid image specification is a list whose car is the symbol
5503 `image', and whose rest is a property list. The property list must
5504 contain a value for key `:type'. That value must be the name of a
5505 supported image type. The rest of the property list depends on the
5509 valid_image_p (object
)
5514 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5516 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5517 struct image_type
*type
= lookup_image_type (symbol
);
5520 valid_p
= type
->valid_p (object
);
5527 /* Log error message with format string FORMAT and argument ARG.
5528 Signaling an error, e.g. when an image cannot be loaded, is not a
5529 good idea because this would interrupt redisplay, and the error
5530 message display would lead to another redisplay. This function
5531 therefore simply displays a message. */
5534 image_error (format
, arg1
, arg2
)
5536 Lisp_Object arg1
, arg2
;
5538 add_to_log (format
, arg1
, arg2
);
5543 /***********************************************************************
5544 Image specifications
5545 ***********************************************************************/
5547 enum image_value_type
5549 IMAGE_DONT_CHECK_VALUE_TYPE
,
5552 IMAGE_POSITIVE_INTEGER_VALUE
,
5553 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5554 IMAGE_INTEGER_VALUE
,
5555 IMAGE_FUNCTION_VALUE
,
5560 /* Structure used when parsing image specifications. */
5562 struct image_keyword
5564 /* Name of keyword. */
5567 /* The type of value allowed. */
5568 enum image_value_type type
;
5570 /* Non-zero means key must be present. */
5573 /* Used to recognize duplicate keywords in a property list. */
5576 /* The value that was found. */
5581 static int parse_image_spec
P_ ((Lisp_Object spec
,
5582 struct image_keyword
*keywords
,
5583 int nkeywords
, Lisp_Object type
,
5584 int allow_other_keys_p
));
5585 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5588 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5589 has the format (image KEYWORD VALUE ...). One of the keyword/
5590 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5591 image_keywords structures of size NKEYWORDS describing other
5592 allowed keyword/value pairs. ALLOW_OTHER_KEYS_P non-zero means
5593 allow KEYWORD/VALUE pairs other than those described by KEYWORDS
5594 without checking them. Value is non-zero if SPEC is valid. */
5597 parse_image_spec (spec
, keywords
, nkeywords
, type
, allow_other_keys_p
)
5599 struct image_keyword
*keywords
;
5602 int allow_other_keys_p
;
5607 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5610 plist
= XCDR (spec
);
5611 while (CONSP (plist
))
5613 Lisp_Object key
, value
;
5615 /* First element of a pair must be a symbol. */
5617 plist
= XCDR (plist
);
5621 /* There must follow a value. */
5624 value
= XCAR (plist
);
5625 plist
= XCDR (plist
);
5627 /* Find key in KEYWORDS. Error if not found. */
5628 for (i
= 0; i
< nkeywords
; ++i
)
5629 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5634 if (!allow_other_keys_p
)
5639 /* Record that we recognized the keyword. If a keywords
5640 was found more than once, it's an error. */
5641 keywords
[i
].value
= value
;
5642 ++keywords
[i
].count
;
5644 if (keywords
[i
].count
> 1)
5647 /* Check type of value against allowed type. */
5648 switch (keywords
[i
].type
)
5650 case IMAGE_STRING_VALUE
:
5651 if (!STRINGP (value
))
5655 case IMAGE_SYMBOL_VALUE
:
5656 if (!SYMBOLP (value
))
5660 case IMAGE_POSITIVE_INTEGER_VALUE
:
5661 if (!INTEGERP (value
) || XINT (value
) <= 0)
5665 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5666 if (!INTEGERP (value
) || XINT (value
) < 0)
5670 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5673 case IMAGE_FUNCTION_VALUE
:
5674 value
= indirect_function (value
);
5676 || COMPILEDP (value
)
5677 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5681 case IMAGE_NUMBER_VALUE
:
5682 if (!INTEGERP (value
) && !FLOATP (value
))
5686 case IMAGE_INTEGER_VALUE
:
5687 if (!INTEGERP (value
))
5691 case IMAGE_BOOL_VALUE
:
5692 if (!NILP (value
) && !EQ (value
, Qt
))
5701 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5705 /* Check that all mandatory fields are present. */
5706 for (i
= 0; i
< nkeywords
; ++i
)
5707 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5710 return NILP (plist
);
5714 /* Return the value of KEY in image specification SPEC. Value is nil
5715 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5716 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5719 image_spec_value (spec
, key
, found
)
5720 Lisp_Object spec
, key
;
5725 xassert (valid_image_p (spec
));
5727 for (tail
= XCDR (spec
);
5728 CONSP (tail
) && CONSP (XCDR (tail
));
5729 tail
= XCDR (XCDR (tail
)))
5731 if (EQ (XCAR (tail
), key
))
5735 return XCAR (XCDR (tail
));
5747 /***********************************************************************
5748 Image type independent image structures
5749 ***********************************************************************/
5751 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5752 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5755 /* Allocate and return a new image structure for image specification
5756 SPEC. SPEC has a hash value of HASH. */
5758 static struct image
*
5759 make_image (spec
, hash
)
5763 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5765 xassert (valid_image_p (spec
));
5766 bzero (img
, sizeof *img
);
5767 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5768 xassert (img
->type
!= NULL
);
5770 img
->data
.lisp_val
= Qnil
;
5771 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5777 /* Free image IMG which was used on frame F, including its resources. */
5786 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5788 /* Remove IMG from the hash table of its cache. */
5790 img
->prev
->next
= img
->next
;
5792 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5795 img
->next
->prev
= img
->prev
;
5797 c
->images
[img
->id
] = NULL
;
5799 /* Free resources, then free IMG. */
5800 img
->type
->free (f
, img
);
5806 /* Prepare image IMG for display on frame F. Must be called before
5807 drawing an image. */
5810 prepare_image_for_display (f
, img
)
5816 /* We're about to display IMG, so set its timestamp to `now'. */
5818 img
->timestamp
= EMACS_SECS (t
);
5820 /* If IMG doesn't have a pixmap yet, load it now, using the image
5821 type dependent loader function. */
5822 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5823 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5828 /***********************************************************************
5829 Helper functions for X image types
5830 ***********************************************************************/
5832 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5833 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5835 Lisp_Object color_name
,
5836 unsigned long dflt
));
5838 /* Free X resources of image IMG which is used on frame F. */
5841 x_clear_image (f
, img
)
5848 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5855 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5857 /* If display has an immutable color map, freeing colors is not
5858 necessary and some servers don't allow it. So don't do it. */
5859 if (class != StaticColor
5860 && class != StaticGray
5861 && class != TrueColor
)
5865 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5866 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5871 xfree (img
->colors
);
5878 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5879 cannot be allocated, use DFLT. Add a newly allocated color to
5880 IMG->colors, so that it can be freed again. Value is the pixel
5883 static unsigned long
5884 x_alloc_image_color (f
, img
, color_name
, dflt
)
5887 Lisp_Object color_name
;
5891 unsigned long result
;
5893 xassert (STRINGP (color_name
));
5895 if (defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5897 /* This isn't called frequently so we get away with simply
5898 reallocating the color vector to the needed size, here. */
5901 (unsigned long *) xrealloc (img
->colors
,
5902 img
->ncolors
* sizeof *img
->colors
);
5903 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5904 result
= color
.pixel
;
5914 /***********************************************************************
5916 ***********************************************************************/
5918 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5921 /* Return a new, initialized image cache that is allocated from the
5922 heap. Call free_image_cache to free an image cache. */
5924 struct image_cache
*
5927 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5930 bzero (c
, sizeof *c
);
5932 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5933 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5934 c
->buckets
= (struct image
**) xmalloc (size
);
5935 bzero (c
->buckets
, size
);
5940 /* Free image cache of frame F. Be aware that X frames share images
5944 free_image_cache (f
)
5947 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5952 /* Cache should not be referenced by any frame when freed. */
5953 xassert (c
->refcount
== 0);
5955 for (i
= 0; i
< c
->used
; ++i
)
5956 free_image (f
, c
->images
[i
]);
5960 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5965 /* Clear image cache of frame F. FORCE_P non-zero means free all
5966 images. FORCE_P zero means clear only images that haven't been
5967 displayed for some time. Should be called from time to time to
5968 reduce the number of loaded images. If image-eviction-seconds is
5969 non-nil, this frees images in the cache which weren't displayed for
5970 at least that many seconds. */
5973 clear_image_cache (f
, force_p
)
5977 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5979 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5983 int i
, any_freed_p
= 0;
5986 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5988 for (i
= 0; i
< c
->used
; ++i
)
5990 struct image
*img
= c
->images
[i
];
5993 || (img
->timestamp
> old
)))
5995 free_image (f
, img
);
6000 /* We may be clearing the image cache because, for example,
6001 Emacs was iconified for a longer period of time. In that
6002 case, current matrices may still contain references to
6003 images freed above. So, clear these matrices. */
6006 clear_current_matrices (f
);
6007 ++windows_or_buffers_changed
;
6013 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6015 "Clear the image cache of FRAME.\n\
6016 FRAME nil or omitted means use the selected frame.\n\
6017 FRAME t means clear the image caches of all frames.")
6025 FOR_EACH_FRAME (tail
, frame
)
6026 if (FRAME_X_P (XFRAME (frame
)))
6027 clear_image_cache (XFRAME (frame
), 1);
6030 clear_image_cache (check_x_frame (frame
), 1);
6036 /* Return the id of image with Lisp specification SPEC on frame F.
6037 SPEC must be a valid Lisp image specification (see valid_image_p). */
6040 lookup_image (f
, spec
)
6044 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6048 struct gcpro gcpro1
;
6051 /* F must be a window-system frame, and SPEC must be a valid image
6053 xassert (FRAME_WINDOW_P (f
));
6054 xassert (valid_image_p (spec
));
6058 /* Look up SPEC in the hash table of the image cache. */
6059 hash
= sxhash (spec
, 0);
6060 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6062 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6063 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6066 /* If not found, create a new image and cache it. */
6069 img
= make_image (spec
, hash
);
6070 cache_image (f
, img
);
6071 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6072 xassert (!interrupt_input_blocked
);
6074 /* If we can't load the image, and we don't have a width and
6075 height, use some arbitrary width and height so that we can
6076 draw a rectangle for it. */
6077 if (img
->load_failed_p
)
6081 value
= image_spec_value (spec
, QCwidth
, NULL
);
6082 img
->width
= (INTEGERP (value
)
6083 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6084 value
= image_spec_value (spec
, QCheight
, NULL
);
6085 img
->height
= (INTEGERP (value
)
6086 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6090 /* Handle image type independent image attributes
6091 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6092 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6095 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6096 if (INTEGERP (ascent
))
6097 img
->ascent
= XFASTINT (ascent
);
6099 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6100 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6101 img
->margin
= XFASTINT (margin
);
6103 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6104 if (INTEGERP (relief
))
6106 img
->relief
= XINT (relief
);
6107 img
->margin
+= abs (img
->relief
);
6110 /* Should we apply a Laplace edge-detection algorithm? */
6111 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6112 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6115 /* Should we built a mask heuristically? */
6116 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6117 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6119 file
= image_spec_value (spec
, QCfile
, NULL
);
6120 x_build_heuristic_mask (f
, file
, img
, heuristic_mask
);
6125 /* We're using IMG, so set its timestamp to `now'. */
6126 EMACS_GET_TIME (now
);
6127 img
->timestamp
= EMACS_SECS (now
);
6131 /* Value is the image id. */
6136 /* Cache image IMG in the image cache of frame F. */
6139 cache_image (f
, img
)
6143 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6146 /* Find a free slot in c->images. */
6147 for (i
= 0; i
< c
->used
; ++i
)
6148 if (c
->images
[i
] == NULL
)
6151 /* If no free slot found, maybe enlarge c->images. */
6152 if (i
== c
->used
&& c
->used
== c
->size
)
6155 c
->images
= (struct image
**) xrealloc (c
->images
,
6156 c
->size
* sizeof *c
->images
);
6159 /* Add IMG to c->images, and assign IMG an id. */
6165 /* Add IMG to the cache's hash table. */
6166 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6167 img
->next
= c
->buckets
[i
];
6169 img
->next
->prev
= img
;
6171 c
->buckets
[i
] = img
;
6175 /* Call FN on every image in the image cache of frame F. Used to mark
6176 Lisp Objects in the image cache. */
6179 forall_images_in_image_cache (f
, fn
)
6181 void (*fn
) P_ ((struct image
*img
));
6183 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6185 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6189 for (i
= 0; i
< c
->used
; ++i
)
6198 /***********************************************************************
6200 ***********************************************************************/
6202 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, Lisp_Object
,
6203 int, int, int, XImage
**,
6205 static void x_destroy_x_image
P_ ((XImage
*));
6206 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6209 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6210 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6211 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6212 via xmalloc. Print error messages via image_error if an error
6213 occurs. FILE is the name of an image file being processed, for
6214 error messages. Value is non-zero if successful. */
6217 x_create_x_image_and_pixmap (f
, file
, width
, height
, depth
, ximg
, pixmap
)
6220 int width
, height
, depth
;
6224 Display
*display
= FRAME_X_DISPLAY (f
);
6225 Screen
*screen
= FRAME_X_SCREEN (f
);
6226 Window window
= FRAME_X_WINDOW (f
);
6228 xassert (interrupt_input_blocked
);
6231 depth
= DefaultDepthOfScreen (screen
);
6232 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6233 depth
, ZPixmap
, 0, NULL
, width
, height
,
6234 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6237 image_error ("Unable to allocate X image for %s", file
, Qnil
);
6241 /* Allocate image raster. */
6242 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6244 /* Allocate a pixmap of the same size. */
6245 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6248 x_destroy_x_image (*ximg
);
6250 image_error ("Unable to create pixmap for `%s'", file
, Qnil
);
6258 /* Destroy XImage XIMG. Free XIMG->data. */
6261 x_destroy_x_image (ximg
)
6264 xassert (interrupt_input_blocked
);
6269 XDestroyImage (ximg
);
6274 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6275 are width and height of both the image and pixmap. */
6278 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6285 xassert (interrupt_input_blocked
);
6286 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6287 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6288 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6293 /***********************************************************************
6295 ***********************************************************************/
6297 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6299 /* Find image file FILE. Look in data-directory, then
6300 x-bitmap-file-path. Value is the full name of the file found, or
6301 nil if not found. */
6304 x_find_image_file (file
)
6307 Lisp_Object file_found
, search_path
;
6308 struct gcpro gcpro1
, gcpro2
;
6312 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6313 GCPRO2 (file_found
, search_path
);
6315 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6316 fd
= openp (search_path
, file
, "", &file_found
, 0);
6329 /***********************************************************************
6331 ***********************************************************************/
6333 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6334 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6336 static int xbm_image_p
P_ ((Lisp_Object object
));
6337 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6341 /* Indices of image specification fields in xbm_format, below. */
6343 enum xbm_keyword_index
6360 /* Vector of image_keyword structures describing the format
6361 of valid XBM image specifications. */
6363 static struct image_keyword xbm_format
[XBM_LAST
] =
6365 {":type", IMAGE_SYMBOL_VALUE
, 1},
6366 {":file", IMAGE_STRING_VALUE
, 0},
6367 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6368 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6369 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6370 {":foreground", IMAGE_STRING_VALUE
, 0},
6371 {":background", IMAGE_STRING_VALUE
, 0},
6372 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6373 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6374 {":relief", IMAGE_INTEGER_VALUE
, 0},
6375 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6376 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6379 /* Structure describing the image type XBM. */
6381 static struct image_type xbm_type
=
6390 /* Tokens returned from xbm_scan. */
6399 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6400 A valid specification is a list starting with the symbol `image'
6401 The rest of the list is a property list which must contain an
6404 If the specification specifies a file to load, it must contain
6405 an entry `:file FILENAME' where FILENAME is a string.
6407 If the specification is for a bitmap loaded from memory it must
6408 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6409 WIDTH and HEIGHT are integers > 0. DATA may be:
6411 1. a string large enough to hold the bitmap data, i.e. it must
6412 have a size >= (WIDTH + 7) / 8 * HEIGHT
6414 2. a bool-vector of size >= WIDTH * HEIGHT
6416 3. a vector of strings or bool-vectors, one for each line of the
6419 Both the file and data forms may contain the additional entries
6420 `:background COLOR' and `:foreground COLOR'. If not present,
6421 foreground and background of the frame on which the image is
6422 displayed, is used. */
6425 xbm_image_p (object
)
6428 struct image_keyword kw
[XBM_LAST
];
6430 bcopy (xbm_format
, kw
, sizeof kw
);
6431 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
, 0))
6434 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6436 if (kw
[XBM_FILE
].count
)
6438 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6446 /* Entries for `:width', `:height' and `:data' must be present. */
6447 if (!kw
[XBM_WIDTH
].count
6448 || !kw
[XBM_HEIGHT
].count
6449 || !kw
[XBM_DATA
].count
)
6452 data
= kw
[XBM_DATA
].value
;
6453 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6454 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6456 /* Check type of data, and width and height against contents of
6462 /* Number of elements of the vector must be >= height. */
6463 if (XVECTOR (data
)->size
< height
)
6466 /* Each string or bool-vector in data must be large enough
6467 for one line of the image. */
6468 for (i
= 0; i
< height
; ++i
)
6470 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6474 if (XSTRING (elt
)->size
6475 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6478 else if (BOOL_VECTOR_P (elt
))
6480 if (XBOOL_VECTOR (elt
)->size
< width
)
6487 else if (STRINGP (data
))
6489 if (XSTRING (data
)->size
6490 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6493 else if (BOOL_VECTOR_P (data
))
6495 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6502 /* Baseline must be a value between 0 and 100 (a percentage). */
6503 if (kw
[XBM_ASCENT
].count
6504 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6511 /* Scan a bitmap file. FP is the stream to read from. Value is
6512 either an enumerator from enum xbm_token, or a character for a
6513 single-character token, or 0 at end of file. If scanning an
6514 identifier, store the lexeme of the identifier in SVAL. If
6515 scanning a number, store its value in *IVAL. */
6518 xbm_scan (fp
, sval
, ival
)
6525 /* Skip white space. */
6526 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6531 else if (isdigit (c
))
6533 int value
= 0, digit
;
6538 if (c
== 'x' || c
== 'X')
6540 while ((c
= fgetc (fp
)) != EOF
)
6544 else if (c
>= 'a' && c
<= 'f')
6545 digit
= c
- 'a' + 10;
6546 else if (c
>= 'A' && c
<= 'F')
6547 digit
= c
- 'A' + 10;
6550 value
= 16 * value
+ digit
;
6553 else if (isdigit (c
))
6556 while ((c
= fgetc (fp
)) != EOF
6558 value
= 8 * value
+ c
- '0';
6564 while ((c
= fgetc (fp
)) != EOF
6566 value
= 10 * value
+ c
- '0';
6574 else if (isalpha (c
) || c
== '_')
6577 while ((c
= fgetc (fp
)) != EOF
6578 && (isalnum (c
) || c
== '_'))
6590 /* Replacement for XReadBitmapFileData which isn't available under old
6591 X versions. FILE is the name of the bitmap file to read. Set
6592 *WIDTH and *HEIGHT to the width and height of the image. Return in
6593 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6597 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6599 int *width
, *height
;
6600 unsigned char **data
;
6603 char buffer
[BUFSIZ
];
6606 int bytes_per_line
, i
, nbytes
;
6612 LA1 = xbm_scan (fp, buffer, &value)
6614 #define expect(TOKEN) \
6615 if (LA1 != (TOKEN)) \
6620 #define expect_ident(IDENT) \
6621 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6626 fp
= fopen (file
, "r");
6630 *width
= *height
= -1;
6632 LA1
= xbm_scan (fp
, buffer
, &value
);
6634 /* Parse defines for width, height and hot-spots. */
6638 expect_ident ("define");
6639 expect (XBM_TK_IDENT
);
6641 if (LA1
== XBM_TK_NUMBER
);
6643 char *p
= strrchr (buffer
, '_');
6644 p
= p
? p
+ 1 : buffer
;
6645 if (strcmp (p
, "width") == 0)
6647 else if (strcmp (p
, "height") == 0)
6650 expect (XBM_TK_NUMBER
);
6653 if (*width
< 0 || *height
< 0)
6656 /* Parse bits. Must start with `static'. */
6657 expect_ident ("static");
6658 if (LA1
== XBM_TK_IDENT
)
6660 if (strcmp (buffer
, "unsigned") == 0)
6663 expect_ident ("char");
6665 else if (strcmp (buffer
, "short") == 0)
6669 if (*width
% 16 && *width
% 16 < 9)
6672 else if (strcmp (buffer
, "char") == 0)
6680 expect (XBM_TK_IDENT
);
6686 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6687 nbytes
= bytes_per_line
* *height
;
6688 p
= *data
= (char *) xmalloc (nbytes
);
6693 for (i
= 0; i
< nbytes
; i
+= 2)
6696 expect (XBM_TK_NUMBER
);
6699 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6702 if (LA1
== ',' || LA1
== '}')
6710 for (i
= 0; i
< nbytes
; ++i
)
6713 expect (XBM_TK_NUMBER
);
6717 if (LA1
== ',' || LA1
== '}')
6743 /* Load XBM image IMG which will be displayed on frame F from file
6744 SPECIFIED_FILE. Value is non-zero if successful. */
6747 xbm_load_image_from_file (f
, img
, specified_file
)
6750 Lisp_Object specified_file
;
6753 unsigned char *data
;
6756 struct gcpro gcpro1
;
6758 xassert (STRINGP (specified_file
));
6762 file
= x_find_image_file (specified_file
);
6763 if (!STRINGP (file
))
6765 image_error ("Cannot find image file %s", specified_file
, Qnil
);
6770 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6771 &img
->height
, &data
);
6774 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6775 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6776 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6779 xassert (img
->width
> 0 && img
->height
> 0);
6781 /* Get foreground and background colors, maybe allocate colors. */
6782 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6784 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6786 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6788 background
= x_alloc_image_color (f
, img
, value
, background
);
6792 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6795 img
->width
, img
->height
,
6796 foreground
, background
,
6800 if (img
->pixmap
== 0)
6802 x_clear_image (f
, img
);
6803 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6811 image_error ("Error loading XBM image %s", img
->spec
, Qnil
);
6818 /* Fill image IMG which is used on frame F with pixmap data. Value is
6819 non-zero if successful. */
6827 Lisp_Object file_name
;
6829 xassert (xbm_image_p (img
->spec
));
6831 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6832 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6833 if (STRINGP (file_name
))
6834 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6837 struct image_keyword fmt
[XBM_LAST
];
6840 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6841 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6845 /* Parse the list specification. */
6846 bcopy (xbm_format
, fmt
, sizeof fmt
);
6847 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
, 0);
6850 /* Get specified width, and height. */
6851 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6852 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6853 xassert (img
->width
> 0 && img
->height
> 0);
6857 if (fmt
[XBM_ASCENT
].count
)
6858 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6860 /* Get foreground and background colors, maybe allocate colors. */
6861 if (fmt
[XBM_FOREGROUND
].count
)
6862 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6864 if (fmt
[XBM_BACKGROUND
].count
)
6865 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6868 /* Set bits to the bitmap image data. */
6869 data
= fmt
[XBM_DATA
].value
;
6874 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6876 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6877 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6879 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6881 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6883 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6886 else if (STRINGP (data
))
6887 bits
= XSTRING (data
)->data
;
6889 bits
= XBOOL_VECTOR (data
)->data
;
6891 /* Create the pixmap. */
6892 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6894 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6897 img
->width
, img
->height
,
6898 foreground
, background
,
6904 image_error ("Unable to create pixmap for XBM image", Qnil
, Qnil
);
6905 x_clear_image (f
, img
);
6916 /***********************************************************************
6918 ***********************************************************************/
6922 static int xpm_image_p
P_ ((Lisp_Object object
));
6923 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6924 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6926 #include "X11/xpm.h"
6928 /* The symbol `xpm' identifying XPM-format images. */
6932 /* Indices of image specification fields in xpm_format, below. */
6934 enum xpm_keyword_index
6948 /* Vector of image_keyword structures describing the format
6949 of valid XPM image specifications. */
6951 static struct image_keyword xpm_format
[XPM_LAST
] =
6953 {":type", IMAGE_SYMBOL_VALUE
, 1},
6954 {":file", IMAGE_STRING_VALUE
, 0},
6955 {":data", IMAGE_STRING_VALUE
, 0},
6956 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6957 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6958 {":relief", IMAGE_INTEGER_VALUE
, 0},
6959 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6960 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6961 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6964 /* Structure describing the image type XBM. */
6966 static struct image_type xpm_type
=
6976 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6977 for XPM images. Such a list must consist of conses whose car and
6981 xpm_valid_color_symbols_p (color_symbols
)
6982 Lisp_Object color_symbols
;
6984 while (CONSP (color_symbols
))
6986 Lisp_Object sym
= XCAR (color_symbols
);
6988 || !STRINGP (XCAR (sym
))
6989 || !STRINGP (XCDR (sym
)))
6991 color_symbols
= XCDR (color_symbols
);
6994 return NILP (color_symbols
);
6998 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7001 xpm_image_p (object
)
7004 struct image_keyword fmt
[XPM_LAST
];
7005 bcopy (xpm_format
, fmt
, sizeof fmt
);
7006 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
, 0)
7007 /* Either `:file' or `:data' must be present. */
7008 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7009 /* Either no `:color-symbols' or it's a list of conses
7010 whose car and cdr are strings. */
7011 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7012 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
7013 && (fmt
[XPM_ASCENT
].count
== 0
7014 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
7018 /* Load image IMG which will be displayed on frame F. Value is
7019 non-zero if successful. */
7027 XpmAttributes attrs
;
7028 Lisp_Object specified_file
, color_symbols
;
7030 /* Configure the XPM lib. Use the visual of frame F. Allocate
7031 close colors. Return colors allocated. */
7032 bzero (&attrs
, sizeof attrs
);
7033 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7034 attrs
.valuemask
|= XpmVisual
;
7035 attrs
.valuemask
|= XpmReturnAllocPixels
;
7036 #ifdef XpmAllocCloseColors
7037 attrs
.alloc_close_colors
= 1;
7038 attrs
.valuemask
|= XpmAllocCloseColors
;
7040 attrs
.closeness
= 600;
7041 attrs
.valuemask
|= XpmCloseness
;
7044 /* If image specification contains symbolic color definitions, add
7045 these to `attrs'. */
7046 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7047 if (CONSP (color_symbols
))
7050 XpmColorSymbol
*xpm_syms
;
7053 attrs
.valuemask
|= XpmColorSymbols
;
7055 /* Count number of symbols. */
7056 attrs
.numsymbols
= 0;
7057 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7060 /* Allocate an XpmColorSymbol array. */
7061 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7062 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7063 bzero (xpm_syms
, size
);
7064 attrs
.colorsymbols
= xpm_syms
;
7066 /* Fill the color symbol array. */
7067 for (tail
= color_symbols
, i
= 0;
7069 ++i
, tail
= XCDR (tail
))
7071 Lisp_Object name
= XCAR (XCAR (tail
));
7072 Lisp_Object color
= XCDR (XCAR (tail
));
7073 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7074 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7075 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7076 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7080 /* Create a pixmap for the image, either from a file, or from a
7081 string buffer containing data in the same format as an XPM file. */
7083 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7084 if (STRINGP (specified_file
))
7086 Lisp_Object file
= x_find_image_file (specified_file
);
7087 if (!STRINGP (file
))
7089 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7094 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7095 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7100 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7101 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7102 XSTRING (buffer
)->data
,
7103 &img
->pixmap
, &img
->mask
,
7108 if (rc
== XpmSuccess
)
7110 /* Remember allocated colors. */
7111 img
->ncolors
= attrs
.nalloc_pixels
;
7112 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7113 * sizeof *img
->colors
);
7114 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7115 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7117 img
->width
= attrs
.width
;
7118 img
->height
= attrs
.height
;
7119 xassert (img
->width
> 0 && img
->height
> 0);
7121 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7123 XpmFreeAttributes (&attrs
);
7131 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7134 case XpmFileInvalid
:
7135 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7139 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7142 case XpmColorFailed
:
7143 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7147 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7152 return rc
== XpmSuccess
;
7155 #endif /* HAVE_XPM != 0 */
7158 /***********************************************************************
7160 ***********************************************************************/
7162 /* An entry in the color table mapping an RGB color to a pixel color. */
7167 unsigned long pixel
;
7169 /* Next in color table collision list. */
7170 struct ct_color
*next
;
7173 /* The bucket vector size to use. Must be prime. */
7177 /* Value is a hash of the RGB color given by R, G, and B. */
7179 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7181 /* The color hash table. */
7183 struct ct_color
**ct_table
;
7185 /* Number of entries in the color table. */
7187 int ct_colors_allocated
;
7189 /* Function prototypes. */
7191 static void init_color_table
P_ ((void));
7192 static void free_color_table
P_ ((void));
7193 static unsigned long *colors_in_color_table
P_ ((int *n
));
7194 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7195 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7198 /* Initialize the color table. */
7203 int size
= CT_SIZE
* sizeof (*ct_table
);
7204 ct_table
= (struct ct_color
**) xmalloc (size
);
7205 bzero (ct_table
, size
);
7206 ct_colors_allocated
= 0;
7210 /* Free memory associated with the color table. */
7216 struct ct_color
*p
, *next
;
7218 for (i
= 0; i
< CT_SIZE
; ++i
)
7219 for (p
= ct_table
[i
]; p
; p
= next
)
7230 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7231 entry for that color already is in the color table, return the
7232 pixel color of that entry. Otherwise, allocate a new color for R,
7233 G, B, and make an entry in the color table. */
7235 static unsigned long
7236 lookup_rgb_color (f
, r
, g
, b
)
7240 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7241 int i
= hash
% CT_SIZE
;
7244 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7245 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7259 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7260 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7265 ++ct_colors_allocated
;
7267 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7271 p
->pixel
= color
.pixel
;
7272 p
->next
= ct_table
[i
];
7276 return FRAME_FOREGROUND_PIXEL (f
);
7283 /* Look up pixel color PIXEL which is used on frame F in the color
7284 table. If not already present, allocate it. Value is PIXEL. */
7286 static unsigned long
7287 lookup_pixel_color (f
, pixel
)
7289 unsigned long pixel
;
7291 int i
= pixel
% CT_SIZE
;
7294 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7295 if (p
->pixel
== pixel
)
7306 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7307 color
.pixel
= pixel
;
7308 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7309 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7314 ++ct_colors_allocated
;
7316 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7321 p
->next
= ct_table
[i
];
7325 return FRAME_FOREGROUND_PIXEL (f
);
7332 /* Value is a vector of all pixel colors contained in the color table,
7333 allocated via xmalloc. Set *N to the number of colors. */
7335 static unsigned long *
7336 colors_in_color_table (n
)
7341 unsigned long *colors
;
7343 if (ct_colors_allocated
== 0)
7350 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7352 *n
= ct_colors_allocated
;
7354 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7355 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7356 colors
[j
++] = p
->pixel
;
7364 /***********************************************************************
7366 ***********************************************************************/
7368 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7369 int, XImage
*, int));
7370 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7371 XColor
*, int, XImage
*, int));
7374 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7375 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7376 the width of one row in the image. */
7379 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7389 for (x
= 0; x
< width
; ++x
)
7390 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7392 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7396 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7397 containing the pixel colors to write. F is the frame we are
7401 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7410 for (x
= 0; x
< width
; ++x
)
7411 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7415 /* Transform image IMG which is used on frame F with a Laplace
7416 edge-detection algorithm. The result is an image that can be used
7417 to draw disabled buttons, for example. */
7424 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7425 XImage
*ximg
, *oimg
;
7431 int in_y
, out_y
, rc
;
7436 /* Get the X image IMG->pixmap. */
7437 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7438 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7440 /* Allocate 3 input rows, and one output row of colors. */
7441 for (i
= 0; i
< 3; ++i
)
7442 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7443 out
= (long *) alloca (img
->width
* sizeof (long));
7445 /* Create an X image for output. */
7446 rc
= x_create_x_image_and_pixmap (f
, Qnil
, img
->width
, img
->height
, 0,
7449 /* Fill first two rows. */
7450 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7451 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7454 /* Write first row, all zeros. */
7455 init_color_table ();
7456 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7457 for (x
= 0; x
< img
->width
; ++x
)
7459 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7462 for (y
= 2; y
< img
->height
; ++y
)
7465 int rowb
= (y
+ 2) % 3;
7467 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7469 for (x
= 0; x
< img
->width
- 2; ++x
)
7471 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7472 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7473 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7475 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7479 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7482 /* Write last line, all zeros. */
7483 for (x
= 0; x
< img
->width
; ++x
)
7485 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7487 /* Free the input image, and free resources of IMG. */
7488 XDestroyImage (ximg
);
7489 x_clear_image (f
, img
);
7491 /* Put the output image into pixmap, and destroy it. */
7492 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7493 x_destroy_x_image (oimg
);
7495 /* Remember new pixmap and colors in IMG. */
7496 img
->pixmap
= pixmap
;
7497 img
->colors
= colors_in_color_table (&img
->ncolors
);
7498 free_color_table ();
7504 /* Build a mask for image IMG which is used on frame F. FILE is the
7505 name of an image file, for error messages. HOW determines how to
7506 determine the background color of IMG. If it is a list '(R G B)',
7507 with R, G, and B being integers >= 0, take that as the color of the
7508 background. Otherwise, determine the background color of IMG
7509 heuristically. Value is non-zero if successful. */
7512 x_build_heuristic_mask (f
, file
, img
, how
)
7518 Display
*dpy
= FRAME_X_DISPLAY (f
);
7519 XImage
*ximg
, *mask_img
;
7520 int x
, y
, rc
, look_at_corners_p
;
7525 /* Create an image and pixmap serving as mask. */
7526 rc
= x_create_x_image_and_pixmap (f
, file
, img
->width
, img
->height
, 1,
7527 &mask_img
, &img
->mask
);
7534 /* Get the X image of IMG->pixmap. */
7535 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7538 /* Determine the background color of ximg. If HOW is `(R G B)'
7539 take that as color. Otherwise, try to determine the color
7541 look_at_corners_p
= 1;
7549 && NATNUMP (XCAR (how
)))
7551 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7555 if (i
== 3 && NILP (how
))
7557 char color_name
[30];
7558 XColor exact
, color
;
7561 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7563 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7564 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7567 look_at_corners_p
= 0;
7572 if (look_at_corners_p
)
7574 unsigned long corners
[4];
7577 /* Get the colors at the corners of ximg. */
7578 corners
[0] = XGetPixel (ximg
, 0, 0);
7579 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7580 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7581 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7583 /* Choose the most frequently found color as background. */
7584 for (i
= best_count
= 0; i
< 4; ++i
)
7588 for (j
= n
= 0; j
< 4; ++j
)
7589 if (corners
[i
] == corners
[j
])
7593 bg
= corners
[i
], best_count
= n
;
7597 /* Set all bits in mask_img to 1 whose color in ximg is different
7598 from the background color bg. */
7599 for (y
= 0; y
< img
->height
; ++y
)
7600 for (x
= 0; x
< img
->width
; ++x
)
7601 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7603 /* Put mask_img into img->mask. */
7604 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7605 x_destroy_x_image (mask_img
);
7606 XDestroyImage (ximg
);
7614 /***********************************************************************
7615 PBM (mono, gray, color)
7616 ***********************************************************************/
7618 static int pbm_image_p
P_ ((Lisp_Object object
));
7619 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7620 static int pbm_scan_number
P_ ((FILE *fp
));
7622 /* The symbol `pbm' identifying images of this type. */
7626 /* Indices of image specification fields in gs_format, below. */
7628 enum pbm_keyword_index
7640 /* Vector of image_keyword structures describing the format
7641 of valid user-defined image specifications. */
7643 static struct image_keyword pbm_format
[PBM_LAST
] =
7645 {":type", IMAGE_SYMBOL_VALUE
, 1},
7646 {":file", IMAGE_STRING_VALUE
, 1},
7647 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7648 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7649 {":relief", IMAGE_INTEGER_VALUE
, 0},
7650 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7651 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7654 /* Structure describing the image type `pbm'. */
7656 static struct image_type pbm_type
=
7666 /* Return non-zero if OBJECT is a valid PBM image specification. */
7669 pbm_image_p (object
)
7672 struct image_keyword fmt
[PBM_LAST
];
7674 bcopy (pbm_format
, fmt
, sizeof fmt
);
7676 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
, 0)
7677 || (fmt
[PBM_ASCENT
].count
7678 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7684 /* Scan a decimal number from PBM input file FP and return it. Value
7685 is -1 at end of file or if an error occurs. */
7688 pbm_scan_number (fp
)
7695 /* Skip white-space. */
7696 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
7701 /* Skip comment to end of line. */
7702 while ((c
= fgetc (fp
)) != EOF
&& c
!= '\n')
7705 else if (isdigit (c
))
7707 /* Read decimal number. */
7709 while ((c
= fgetc (fp
)) != EOF
&& isdigit (c
))
7710 val
= 10 * val
+ c
- '0';
7721 /* Load PBM image IMG for use on frame F. */
7731 int width
, height
, max_color_idx
= 0;
7733 Lisp_Object file
, specified_file
;
7734 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7735 struct gcpro gcpro1
;
7737 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7738 file
= x_find_image_file (specified_file
);
7740 if (!STRINGP (file
))
7742 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7747 fp
= fopen (XSTRING (file
)->data
, "r");
7754 /* Read first two characters. */
7755 if (fread (magic
, sizeof *magic
, 2, fp
) != 2)
7758 image_error ("Not a PBM image file: %s", file
, Qnil
);
7766 image_error ("Not a PBM image file: %s", file
, Qnil
);
7774 raw_p
= 0, type
= PBM_MONO
;
7778 raw_p
= 0, type
= PBM_GRAY
;
7782 raw_p
= 0, type
= PBM_COLOR
;
7786 raw_p
= 1, type
= PBM_MONO
;
7790 raw_p
= 1, type
= PBM_GRAY
;
7794 raw_p
= 1, type
= PBM_COLOR
;
7799 image_error ("Not a PBM image file: %s", file
, Qnil
);
7804 /* Read width, height, maximum color-component. Characters
7805 starting with `#' up to the end of a line are ignored. */
7806 width
= pbm_scan_number (fp
);
7807 height
= pbm_scan_number (fp
);
7809 if (type
!= PBM_MONO
)
7811 max_color_idx
= pbm_scan_number (fp
);
7812 if (raw_p
&& max_color_idx
> 255)
7813 max_color_idx
= 255;
7816 if (width
< 0 || height
< 0
7817 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7825 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0,
7826 &ximg
, &img
->pixmap
))
7834 /* Initialize the color hash table. */
7835 init_color_table ();
7837 if (type
== PBM_MONO
)
7841 for (y
= 0; y
< height
; ++y
)
7842 for (x
= 0; x
< width
; ++x
)
7852 g
= pbm_scan_number (fp
);
7854 XPutPixel (ximg
, x
, y
, (g
7855 ? FRAME_FOREGROUND_PIXEL (f
)
7856 : FRAME_BACKGROUND_PIXEL (f
)));
7861 for (y
= 0; y
< height
; ++y
)
7862 for (x
= 0; x
< width
; ++x
)
7866 if (type
== PBM_GRAY
)
7867 r
= g
= b
= raw_p
? fgetc (fp
) : pbm_scan_number (fp
);
7876 r
= pbm_scan_number (fp
);
7877 g
= pbm_scan_number (fp
);
7878 b
= pbm_scan_number (fp
);
7881 if (r
< 0 || g
< 0 || b
< 0)
7886 XDestroyImage (ximg
);
7888 image_error ("Invalid pixel value in file `%s'",
7894 /* RGB values are now in the range 0..max_color_idx.
7895 Scale this to the range 0..0xffff supported by X. */
7896 r
= (double) r
* 65535 / max_color_idx
;
7897 g
= (double) g
* 65535 / max_color_idx
;
7898 b
= (double) b
* 65535 / max_color_idx
;
7899 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7905 /* Store in IMG->colors the colors allocated for the image, and
7906 free the color table. */
7907 img
->colors
= colors_in_color_table (&img
->ncolors
);
7908 free_color_table ();
7910 /* Put the image into a pixmap. */
7911 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7912 x_destroy_x_image (ximg
);
7916 img
->height
= height
;
7924 /***********************************************************************
7926 ***********************************************************************/
7932 /* Function prototypes. */
7934 static int png_image_p
P_ ((Lisp_Object object
));
7935 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7937 /* The symbol `png' identifying images of this type. */
7941 /* Indices of image specification fields in png_format, below. */
7943 enum png_keyword_index
7955 /* Vector of image_keyword structures describing the format
7956 of valid user-defined image specifications. */
7958 static struct image_keyword png_format
[PNG_LAST
] =
7960 {":type", IMAGE_SYMBOL_VALUE
, 1},
7961 {":file", IMAGE_STRING_VALUE
, 1},
7962 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7963 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7964 {":relief", IMAGE_INTEGER_VALUE
, 0},
7965 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7966 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7969 /* Structure describing the image type `gif'. */
7971 static struct image_type png_type
=
7981 /* Return non-zero if OBJECT is a valid PNG image specification. */
7984 png_image_p (object
)
7987 struct image_keyword fmt
[PNG_LAST
];
7988 bcopy (png_format
, fmt
, sizeof fmt
);
7990 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
, 1)
7991 || (fmt
[PNG_ASCENT
].count
7992 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7998 /* Error and warning handlers installed when the PNG library
8002 my_png_error (png_ptr
, msg
)
8003 png_struct
*png_ptr
;
8006 xassert (png_ptr
!= NULL
);
8007 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8008 longjmp (png_ptr
->jmpbuf
, 1);
8013 my_png_warning (png_ptr
, msg
)
8014 png_struct
*png_ptr
;
8017 xassert (png_ptr
!= NULL
);
8018 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8022 /* Load PNG image IMG for use on frame F. Value is non-zero if
8030 Lisp_Object file
, specified_file
;
8032 XImage
*ximg
, *mask_img
= NULL
;
8033 struct gcpro gcpro1
;
8034 png_struct
*png_ptr
= NULL
;
8035 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8038 png_byte
*pixels
= NULL
;
8039 png_byte
**rows
= NULL
;
8040 png_uint_32 width
, height
;
8041 int bit_depth
, color_type
, interlace_type
;
8043 png_uint_32 row_bytes
;
8046 double screen_gamma
, image_gamma
;
8049 /* Find out what file to load. */
8050 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8051 file
= x_find_image_file (specified_file
);
8053 if (!STRINGP (file
))
8055 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8060 /* Open the image file. */
8061 fp
= fopen (XSTRING (file
)->data
, "rb");
8064 image_error ("Cannot open image file %s", file
, Qnil
);
8070 /* Check PNG signature. */
8071 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8072 || !png_check_sig (sig
, sizeof sig
))
8074 image_error ("Not a PNG file: %s", file
, Qnil
);
8080 /* Initialize read and info structs for PNG lib. */
8081 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8082 my_png_error
, my_png_warning
);
8090 info_ptr
= png_create_info_struct (png_ptr
);
8093 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8099 end_info
= png_create_info_struct (png_ptr
);
8102 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8108 /* Set error jump-back. We come back here when the PNG library
8109 detects an error. */
8110 if (setjmp (png_ptr
->jmpbuf
))
8114 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8123 /* Read image info. */
8124 png_init_io (png_ptr
, fp
);
8125 png_set_sig_bytes (png_ptr
, sizeof sig
);
8126 png_read_info (png_ptr
, info_ptr
);
8127 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8128 &interlace_type
, NULL
, NULL
);
8130 /* If image contains simply transparency data, we prefer to
8131 construct a clipping mask. */
8132 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8137 /* This function is easier to write if we only have to handle
8138 one data format: RGB or RGBA with 8 bits per channel. Let's
8139 transform other formats into that format. */
8141 /* Strip more than 8 bits per channel. */
8142 if (bit_depth
== 16)
8143 png_set_strip_16 (png_ptr
);
8145 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8147 png_set_expand (png_ptr
);
8149 /* Convert grayscale images to RGB. */
8150 if (color_type
== PNG_COLOR_TYPE_GRAY
8151 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8152 png_set_gray_to_rgb (png_ptr
);
8154 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8155 gamma_str
= getenv ("SCREEN_GAMMA");
8156 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8158 /* Tell the PNG lib to handle gamma correction for us. */
8160 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8161 /* There is a special chunk in the image specifying the gamma. */
8162 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8163 else if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8164 /* Image contains gamma information. */
8165 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8167 /* Use a default of 0.5 for the image gamma. */
8168 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8170 /* Handle alpha channel by combining the image with a background
8171 color. Do this only if a real alpha channel is supplied. For
8172 simple transparency, we prefer a clipping mask. */
8175 png_color_16
*image_background
;
8177 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8178 /* Image contains a background color with which to
8179 combine the image. */
8180 png_set_background (png_ptr
, image_background
,
8181 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8184 /* Image does not contain a background color with which
8185 to combine the image data via an alpha channel. Use
8186 the frame's background instead. */
8189 png_color_16 frame_background
;
8192 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8193 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8194 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8197 bzero (&frame_background
, sizeof frame_background
);
8198 frame_background
.red
= color
.red
;
8199 frame_background
.green
= color
.green
;
8200 frame_background
.blue
= color
.blue
;
8202 png_set_background (png_ptr
, &frame_background
,
8203 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8207 /* Update info structure. */
8208 png_read_update_info (png_ptr
, info_ptr
);
8210 /* Get number of channels. Valid values are 1 for grayscale images
8211 and images with a palette, 2 for grayscale images with transparency
8212 information (alpha channel), 3 for RGB images, and 4 for RGB
8213 images with alpha channel, i.e. RGBA. If conversions above were
8214 sufficient we should only have 3 or 4 channels here. */
8215 channels
= png_get_channels (png_ptr
, info_ptr
);
8216 xassert (channels
== 3 || channels
== 4);
8218 /* Number of bytes needed for one row of the image. */
8219 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8221 /* Allocate memory for the image. */
8222 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8223 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8224 for (i
= 0; i
< height
; ++i
)
8225 rows
[i
] = pixels
+ i
* row_bytes
;
8227 /* Read the entire image. */
8228 png_read_image (png_ptr
, rows
);
8229 png_read_end (png_ptr
, info_ptr
);
8235 /* Create the X image and pixmap. */
8236 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8243 /* Create an image and pixmap serving as mask if the PNG image
8244 contains an alpha channel. */
8247 && !x_create_x_image_and_pixmap (f
, file
, width
, height
, 1,
8248 &mask_img
, &img
->mask
))
8250 x_destroy_x_image (ximg
);
8251 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8257 /* Fill the X image and mask from PNG data. */
8258 init_color_table ();
8260 for (y
= 0; y
< height
; ++y
)
8262 png_byte
*p
= rows
[y
];
8264 for (x
= 0; x
< width
; ++x
)
8271 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8273 /* An alpha channel, aka mask channel, associates variable
8274 transparency with an image. Where other image formats
8275 support binary transparency---fully transparent or fully
8276 opaque---PNG allows up to 254 levels of partial transparency.
8277 The PNG library implements partial transparency by combining
8278 the image with a specified background color.
8280 I'm not sure how to handle this here nicely: because the
8281 background on which the image is displayed may change, for
8282 real alpha channel support, it would be necessary to create
8283 a new image for each possible background.
8285 What I'm doing now is that a mask is created if we have
8286 boolean transparency information. Otherwise I'm using
8287 the frame's background color to combine the image with. */
8292 XPutPixel (mask_img
, x
, y
, *p
> 0);
8298 /* Remember colors allocated for this image. */
8299 img
->colors
= colors_in_color_table (&img
->ncolors
);
8300 free_color_table ();
8303 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8308 img
->height
= height
;
8310 /* Put the image into the pixmap, then free the X image and its buffer. */
8311 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8312 x_destroy_x_image (ximg
);
8314 /* Same for the mask. */
8317 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8318 x_destroy_x_image (mask_img
);
8326 #endif /* HAVE_PNG != 0 */
8330 /***********************************************************************
8332 ***********************************************************************/
8336 /* Work around a warning about HAVE_STDLIB_H being redefined in
8338 #ifdef HAVE_STDLIB_H
8339 #define HAVE_STDLIB_H_1
8340 #undef HAVE_STDLIB_H
8341 #endif /* HAVE_STLIB_H */
8343 #include <jpeglib.h>
8347 #ifdef HAVE_STLIB_H_1
8348 #define HAVE_STDLIB_H 1
8351 static int jpeg_image_p
P_ ((Lisp_Object object
));
8352 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8354 /* The symbol `jpeg' identifying images of this type. */
8358 /* Indices of image specification fields in gs_format, below. */
8360 enum jpeg_keyword_index
8368 JPEG_HEURISTIC_MASK
,
8372 /* Vector of image_keyword structures describing the format
8373 of valid user-defined image specifications. */
8375 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8377 {":type", IMAGE_SYMBOL_VALUE
, 1},
8378 {":file", IMAGE_STRING_VALUE
, 1},
8379 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8380 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8381 {":relief", IMAGE_INTEGER_VALUE
, 0},
8382 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8383 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8386 /* Structure describing the image type `jpeg'. */
8388 static struct image_type jpeg_type
=
8398 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8401 jpeg_image_p (object
)
8404 struct image_keyword fmt
[JPEG_LAST
];
8406 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8408 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
, 0)
8409 || (fmt
[JPEG_ASCENT
].count
8410 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8415 struct my_jpeg_error_mgr
8417 struct jpeg_error_mgr pub
;
8418 jmp_buf setjmp_buffer
;
8422 my_error_exit (cinfo
)
8425 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8426 longjmp (mgr
->setjmp_buffer
, 1);
8429 /* Load image IMG for use on frame F. Patterned after example.c
8430 from the JPEG lib. */
8437 struct jpeg_decompress_struct cinfo
;
8438 struct my_jpeg_error_mgr mgr
;
8439 Lisp_Object file
, specified_file
;
8442 int row_stride
, x
, y
;
8443 XImage
*ximg
= NULL
;
8445 unsigned long *colors
;
8447 struct gcpro gcpro1
;
8449 /* Open the JPEG file. */
8450 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8451 file
= x_find_image_file (specified_file
);
8453 if (!STRINGP (file
))
8455 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8460 fp
= fopen (XSTRING (file
)->data
, "r");
8463 image_error ("Cannot open `%s'", file
, Qnil
);
8468 /* Customize libjpeg's error handling to call my_error_exit
8469 when an error is detected. This function will perform
8471 mgr
.pub
.error_exit
= my_error_exit
;
8472 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8474 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8478 /* Called from my_error_exit. Display a JPEG error. */
8479 char buffer
[JMSG_LENGTH_MAX
];
8480 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8481 image_error ("Error reading JPEG file `%s': %s", file
,
8482 build_string (buffer
));
8485 /* Close the input file and destroy the JPEG object. */
8487 jpeg_destroy_decompress (&cinfo
);
8491 /* If we already have an XImage, free that. */
8492 x_destroy_x_image (ximg
);
8494 /* Free pixmap and colors. */
8495 x_clear_image (f
, img
);
8502 /* Create the JPEG decompression object. Let it read from fp.
8503 Read the JPEG image header. */
8504 jpeg_create_decompress (&cinfo
);
8505 jpeg_stdio_src (&cinfo
, fp
);
8506 jpeg_read_header (&cinfo
, TRUE
);
8508 /* Customize decompression so that color quantization will be used.
8509 Start decompression. */
8510 cinfo
.quantize_colors
= TRUE
;
8511 jpeg_start_decompress (&cinfo
);
8512 width
= img
->width
= cinfo
.output_width
;
8513 height
= img
->height
= cinfo
.output_height
;
8517 /* Create X image and pixmap. */
8518 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8522 longjmp (mgr
.setjmp_buffer
, 2);
8525 /* Allocate colors. When color quantization is used,
8526 cinfo.actual_number_of_colors has been set with the number of
8527 colors generated, and cinfo.colormap is a two-dimensional array
8528 of color indices in the range 0..cinfo.actual_number_of_colors.
8529 No more than 255 colors will be generated. */
8533 if (cinfo
.out_color_components
> 2)
8534 ir
= 0, ig
= 1, ib
= 2;
8535 else if (cinfo
.out_color_components
> 1)
8536 ir
= 0, ig
= 1, ib
= 0;
8538 ir
= 0, ig
= 0, ib
= 0;
8540 /* Use the color table mechanism because it handles colors that
8541 cannot be allocated nicely. Such colors will be replaced with
8542 a default color, and we don't have to care about which colors
8543 can be freed safely, and which can't. */
8544 init_color_table ();
8545 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8548 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8550 /* Multiply RGB values with 255 because X expects RGB values
8551 in the range 0..0xffff. */
8552 int r
= cinfo
.colormap
[ir
][i
] << 8;
8553 int g
= cinfo
.colormap
[ig
][i
] << 8;
8554 int b
= cinfo
.colormap
[ib
][i
] << 8;
8555 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8558 /* Remember those colors actually allocated. */
8559 img
->colors
= colors_in_color_table (&img
->ncolors
);
8560 free_color_table ();
8564 row_stride
= width
* cinfo
.output_components
;
8565 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8567 for (y
= 0; y
< height
; ++y
)
8569 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8570 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8571 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8575 jpeg_finish_decompress (&cinfo
);
8576 jpeg_destroy_decompress (&cinfo
);
8579 /* Put the image into the pixmap. */
8580 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8581 x_destroy_x_image (ximg
);
8587 #endif /* HAVE_JPEG */
8591 /***********************************************************************
8593 ***********************************************************************/
8599 static int tiff_image_p
P_ ((Lisp_Object object
));
8600 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8602 /* The symbol `tiff' identifying images of this type. */
8606 /* Indices of image specification fields in tiff_format, below. */
8608 enum tiff_keyword_index
8616 TIFF_HEURISTIC_MASK
,
8620 /* Vector of image_keyword structures describing the format
8621 of valid user-defined image specifications. */
8623 static struct image_keyword tiff_format
[TIFF_LAST
] =
8625 {":type", IMAGE_SYMBOL_VALUE
, 1},
8626 {":file", IMAGE_STRING_VALUE
, 1},
8627 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8628 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8629 {":relief", IMAGE_INTEGER_VALUE
, 0},
8630 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8631 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8634 /* Structure describing the image type `tiff'. */
8636 static struct image_type tiff_type
=
8646 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8649 tiff_image_p (object
)
8652 struct image_keyword fmt
[TIFF_LAST
];
8653 bcopy (tiff_format
, fmt
, sizeof fmt
);
8655 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
, 1)
8656 || (fmt
[TIFF_ASCENT
].count
8657 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8663 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8671 Lisp_Object file
, specified_file
;
8673 int width
, height
, x
, y
;
8677 struct gcpro gcpro1
;
8679 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8680 file
= x_find_image_file (specified_file
);
8682 if (!STRINGP (file
))
8684 image_error ("Cannot find image file %s", file
, Qnil
);
8689 /* Try to open the image file. */
8690 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8693 image_error ("Cannot open `%s'", file
, Qnil
);
8698 /* Get width and height of the image, and allocate a raster buffer
8699 of width x height 32-bit values. */
8700 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8701 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8702 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8704 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8708 image_error ("Error reading `%s'", file
, Qnil
);
8716 /* Create the X image and pixmap. */
8717 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8726 /* Initialize the color table. */
8727 init_color_table ();
8729 /* Process the pixel raster. Origin is in the lower-left corner. */
8730 for (y
= 0; y
< height
; ++y
)
8732 uint32
*row
= buf
+ y
* width
;
8734 for (x
= 0; x
< width
; ++x
)
8736 uint32 abgr
= row
[x
];
8737 int r
= TIFFGetR (abgr
) << 8;
8738 int g
= TIFFGetG (abgr
) << 8;
8739 int b
= TIFFGetB (abgr
) << 8;
8740 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8744 /* Remember the colors allocated for the image. Free the color table. */
8745 img
->colors
= colors_in_color_table (&img
->ncolors
);
8746 free_color_table ();
8748 /* Put the image into the pixmap, then free the X image and its buffer. */
8749 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8750 x_destroy_x_image (ximg
);
8755 img
->height
= height
;
8761 #endif /* HAVE_TIFF != 0 */
8765 /***********************************************************************
8767 ***********************************************************************/
8771 #include <gif_lib.h>
8773 static int gif_image_p
P_ ((Lisp_Object object
));
8774 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8776 /* The symbol `gif' identifying images of this type. */
8780 /* Indices of image specification fields in gif_format, below. */
8782 enum gif_keyword_index
8795 /* Vector of image_keyword structures describing the format
8796 of valid user-defined image specifications. */
8798 static struct image_keyword gif_format
[GIF_LAST
] =
8800 {":type", IMAGE_SYMBOL_VALUE
, 1},
8801 {":file", IMAGE_STRING_VALUE
, 1},
8802 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8803 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8804 {":relief", IMAGE_INTEGER_VALUE
, 0},
8805 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8806 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8807 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8810 /* Structure describing the image type `gif'. */
8812 static struct image_type gif_type
=
8822 /* Return non-zero if OBJECT is a valid GIF image specification. */
8825 gif_image_p (object
)
8828 struct image_keyword fmt
[GIF_LAST
];
8829 bcopy (gif_format
, fmt
, sizeof fmt
);
8831 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
, 1)
8832 || (fmt
[GIF_ASCENT
].count
8833 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8839 /* Load GIF image IMG for use on frame F. Value is non-zero if
8847 Lisp_Object file
, specified_file
;
8848 int rc
, width
, height
, x
, y
, i
;
8850 ColorMapObject
*gif_color_map
;
8851 unsigned long pixel_colors
[256];
8853 struct gcpro gcpro1
;
8855 int ino
, image_left
, image_top
, image_width
, image_height
;
8857 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8858 file
= x_find_image_file (specified_file
);
8860 if (!STRINGP (file
))
8862 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8867 /* Open the GIF file. */
8868 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8871 image_error ("Cannot open `%s'", file
, Qnil
);
8876 /* Read entire contents. */
8877 rc
= DGifSlurp (gif
);
8878 if (rc
== GIF_ERROR
)
8880 image_error ("Error reading `%s'", file
, Qnil
);
8881 DGifCloseFile (gif
);
8886 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8887 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8888 if (ino
>= gif
->ImageCount
)
8890 image_error ("Invalid image number `%s'", image
, Qnil
);
8891 DGifCloseFile (gif
);
8896 width
= img
->width
= gif
->SWidth
;
8897 height
= img
->height
= gif
->SHeight
;
8901 /* Create the X image and pixmap. */
8902 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8906 DGifCloseFile (gif
);
8911 /* Allocate colors. */
8912 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8914 gif_color_map
= gif
->SColorMap
;
8915 init_color_table ();
8916 bzero (pixel_colors
, sizeof pixel_colors
);
8918 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8920 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8921 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8922 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8923 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8926 img
->colors
= colors_in_color_table (&img
->ncolors
);
8927 free_color_table ();
8929 /* Clear the part of the screen image that are not covered by
8930 the image from the GIF file. Full animated GIF support
8931 requires more than can be done here (see the gif89 spec,
8932 disposal methods). Let's simply assume that the part
8933 not covered by a sub-image is in the frame's background color. */
8934 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8935 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8936 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8937 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8939 for (y
= 0; y
< image_top
; ++y
)
8940 for (x
= 0; x
< width
; ++x
)
8941 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8943 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8944 for (x
= 0; x
< width
; ++x
)
8945 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8947 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8949 for (x
= 0; x
< image_left
; ++x
)
8950 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8951 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8952 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8955 /* Read the GIF image into the X image. */
8956 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8958 static int interlace_start
[] = {0, 4, 2, 1};
8959 static int interlace_increment
[] = {8, 8, 4, 2};
8962 for (pass
= 0; pass
< 4; ++pass
)
8964 inc
= interlace_increment
[pass
];
8965 for (y
= interlace_start
[pass
]; y
< image_height
; y
+= inc
)
8966 for (x
= 0; x
< image_width
; ++x
)
8968 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8969 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
,
8976 for (y
= 0; y
< image_height
; ++y
)
8977 for (x
= 0; x
< image_width
; ++x
)
8979 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8980 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8984 DGifCloseFile (gif
);
8986 /* Put the image into the pixmap, then free the X image and its buffer. */
8987 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8988 x_destroy_x_image (ximg
);
8995 #endif /* HAVE_GIF != 0 */
8999 /***********************************************************************
9001 ***********************************************************************/
9003 static int gs_image_p
P_ ((Lisp_Object object
));
9004 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9005 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9007 /* The symbol `postscript' identifying images of this type. */
9009 Lisp_Object Qpostscript
;
9011 /* Keyword symbols. */
9013 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9015 /* Indices of image specification fields in gs_format, below. */
9017 enum gs_keyword_index
9033 /* Vector of image_keyword structures describing the format
9034 of valid user-defined image specifications. */
9036 static struct image_keyword gs_format
[GS_LAST
] =
9038 {":type", IMAGE_SYMBOL_VALUE
, 1},
9039 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9040 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9041 {":file", IMAGE_STRING_VALUE
, 1},
9042 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9043 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9044 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9045 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9046 {":relief", IMAGE_INTEGER_VALUE
, 0},
9047 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9048 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9051 /* Structure describing the image type `ghostscript'. */
9053 static struct image_type gs_type
=
9063 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9066 gs_clear_image (f
, img
)
9070 /* IMG->data.ptr_val may contain a recorded colormap. */
9071 xfree (img
->data
.ptr_val
);
9072 x_clear_image (f
, img
);
9076 /* Return non-zero if OBJECT is a valid Ghostscript image
9083 struct image_keyword fmt
[GS_LAST
];
9087 bcopy (gs_format
, fmt
, sizeof fmt
);
9089 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
, 1)
9090 || (fmt
[GS_ASCENT
].count
9091 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9094 /* Bounding box must be a list or vector containing 4 integers. */
9095 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9098 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9099 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9104 else if (VECTORP (tem
))
9106 if (XVECTOR (tem
)->size
!= 4)
9108 for (i
= 0; i
< 4; ++i
)
9109 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9119 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9128 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9129 struct gcpro gcpro1
, gcpro2
;
9131 double in_width
, in_height
;
9132 Lisp_Object pixel_colors
= Qnil
;
9134 /* Compute pixel size of pixmap needed from the given size in the
9135 image specification. Sizes in the specification are in pt. 1 pt
9136 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9138 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9139 in_width
= XFASTINT (pt_width
) / 72.0;
9140 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9141 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9142 in_height
= XFASTINT (pt_height
) / 72.0;
9143 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9145 /* Create the pixmap. */
9147 xassert (img
->pixmap
== 0);
9148 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9149 img
->width
, img
->height
,
9150 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9155 image_error ("Unable to create pixmap for `%s'",
9156 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9160 /* Call the loader to fill the pixmap. It returns a process object
9161 if successful. We do not record_unwind_protect here because
9162 other places in redisplay like calling window scroll functions
9163 don't either. Let the Lisp loader use `unwind-protect' instead. */
9164 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9166 sprintf (buffer
, "%lu %lu",
9167 (unsigned long) FRAME_X_WINDOW (f
),
9168 (unsigned long) img
->pixmap
);
9169 window_and_pixmap_id
= build_string (buffer
);
9171 sprintf (buffer
, "%lu %lu",
9172 FRAME_FOREGROUND_PIXEL (f
),
9173 FRAME_BACKGROUND_PIXEL (f
));
9174 pixel_colors
= build_string (buffer
);
9176 XSETFRAME (frame
, f
);
9177 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9179 loader
= intern ("gs-load-image");
9181 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9182 make_number (img
->width
),
9183 make_number (img
->height
),
9184 window_and_pixmap_id
,
9187 return PROCESSP (img
->data
.lisp_val
);
9191 /* Kill the Ghostscript process that was started to fill PIXMAP on
9192 frame F. Called from XTread_socket when receiving an event
9193 telling Emacs that Ghostscript has finished drawing. */
9196 x_kill_gs_process (pixmap
, f
)
9200 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9204 /* Find the image containing PIXMAP. */
9205 for (i
= 0; i
< c
->used
; ++i
)
9206 if (c
->images
[i
]->pixmap
== pixmap
)
9209 /* Kill the GS process. We should have found PIXMAP in the image
9210 cache and its image should contain a process object. */
9211 xassert (i
< c
->used
);
9213 xassert (PROCESSP (img
->data
.lisp_val
));
9214 Fkill_process (img
->data
.lisp_val
, Qnil
);
9215 img
->data
.lisp_val
= Qnil
;
9217 /* On displays with a mutable colormap, figure out the colors
9218 allocated for the image by looking at the pixels of an XImage for
9220 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9221 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9227 /* Try to get an XImage for img->pixmep. */
9228 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9229 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9234 /* Initialize the color table. */
9235 init_color_table ();
9237 /* For each pixel of the image, look its color up in the
9238 color table. After having done so, the color table will
9239 contain an entry for each color used by the image. */
9240 for (y
= 0; y
< img
->height
; ++y
)
9241 for (x
= 0; x
< img
->width
; ++x
)
9243 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9244 lookup_pixel_color (f
, pixel
);
9247 /* Record colors in the image. Free color table and XImage. */
9248 img
->colors
= colors_in_color_table (&img
->ncolors
);
9249 free_color_table ();
9250 XDestroyImage (ximg
);
9252 #if 0 /* This doesn't seem to be the case. If we free the colors
9253 here, we get a BadAccess later in x_clear_image when
9254 freeing the colors. */
9255 /* We have allocated colors once, but Ghostscript has also
9256 allocated colors on behalf of us. So, to get the
9257 reference counts right, free them once. */
9260 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9261 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9262 img
->colors
, img
->ncolors
, 0);
9267 image_error ("Cannot get X image of `%s'; colors will not be freed",
9268 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9276 /***********************************************************************
9278 ***********************************************************************/
9280 DEFUN ("x-change-window-property", Fx_change_window_property
,
9281 Sx_change_window_property
, 2, 3, 0,
9282 "Change window property PROP to VALUE on the X window of FRAME.\n\
9283 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9284 selected frame. Value is VALUE.")
9285 (prop
, value
, frame
)
9286 Lisp_Object frame
, prop
, value
;
9288 struct frame
*f
= check_x_frame (frame
);
9291 CHECK_STRING (prop
, 1);
9292 CHECK_STRING (value
, 2);
9295 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9296 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9297 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9298 XSTRING (value
)->data
, XSTRING (value
)->size
);
9300 /* Make sure the property is set when we return. */
9301 XFlush (FRAME_X_DISPLAY (f
));
9308 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9309 Sx_delete_window_property
, 1, 2, 0,
9310 "Remove window property PROP from X window of FRAME.\n\
9311 FRAME nil or omitted means use the selected frame. Value is PROP.")
9313 Lisp_Object prop
, frame
;
9315 struct frame
*f
= check_x_frame (frame
);
9318 CHECK_STRING (prop
, 1);
9320 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9321 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9323 /* Make sure the property is removed when we return. */
9324 XFlush (FRAME_X_DISPLAY (f
));
9331 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9333 "Value is the value of window property PROP on FRAME.\n\
9334 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9335 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9338 Lisp_Object prop
, frame
;
9340 struct frame
*f
= check_x_frame (frame
);
9343 Lisp_Object prop_value
= Qnil
;
9344 char *tmp_data
= NULL
;
9347 unsigned long actual_size
, bytes_remaining
;
9349 CHECK_STRING (prop
, 1);
9351 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9352 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9353 prop_atom
, 0, 0, False
, XA_STRING
,
9354 &actual_type
, &actual_format
, &actual_size
,
9355 &bytes_remaining
, (unsigned char **) &tmp_data
);
9358 int size
= bytes_remaining
;
9363 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9364 prop_atom
, 0, bytes_remaining
,
9366 &actual_type
, &actual_format
,
9367 &actual_size
, &bytes_remaining
,
9368 (unsigned char **) &tmp_data
);
9370 prop_value
= make_string (tmp_data
, size
);
9381 /***********************************************************************
9383 ***********************************************************************/
9385 /* The implementation partly follows a patch from
9386 F.Pierresteguy@frcl.bull.fr dated 1994. */
9388 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9389 the next X event is read and we enter XTread_socket again. Setting
9390 it to 1 inhibits busy-cursor display for direct commands. */
9392 int inhibit_busy_cursor
;
9394 /* Incremented with each call to x-display-busy-cursor.
9395 Decremented in x-undisplay-busy-cursor. */
9397 static int busy_count
;
9400 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9401 Sx_show_busy_cursor
, 0, 0, 0,
9402 "Show a busy cursor, if not already shown.\n\
9403 Each call to this function must be matched by a call to\n\
9404 x-undisplay-busy-cursor to make the busy pointer disappear again.")
9408 if (busy_count
== 1)
9410 Lisp_Object rest
, frame
;
9412 FOR_EACH_FRAME (rest
, frame
)
9413 if (FRAME_X_P (XFRAME (frame
)))
9415 struct frame
*f
= XFRAME (frame
);
9418 f
->output_data
.x
->busy_p
= 1;
9420 if (!f
->output_data
.x
->busy_window
)
9422 unsigned long mask
= CWCursor
;
9423 XSetWindowAttributes attrs
;
9425 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9426 f
->output_data
.x
->busy_window
9427 = XCreateWindow (FRAME_X_DISPLAY (f
),
9428 FRAME_OUTER_WINDOW (f
),
9429 0, 0, 32000, 32000, 0, 0,
9430 InputOnly
, CopyFromParent
,
9434 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9443 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9444 Sx_hide_busy_cursor
, 0, 1, 0,
9445 "Hide a busy-cursor.\n\
9446 A busy-cursor will actually be undisplayed when a matching\n\
9447 `x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
9448 issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
9449 not counting calls.")
9453 Lisp_Object rest
, frame
;
9455 if (busy_count
== 0)
9458 if (!NILP (force
) && busy_count
!= 0)
9462 if (busy_count
!= 0)
9465 FOR_EACH_FRAME (rest
, frame
)
9467 struct frame
*f
= XFRAME (frame
);
9470 /* Watch out for newly created frames. */
9471 && f
->output_data
.x
->busy_window
)
9475 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9476 /* Sync here because XTread_socket looks at the busy_p flag
9477 that is reset to zero below. */
9478 XSync (FRAME_X_DISPLAY (f
), False
);
9480 f
->output_data
.x
->busy_p
= 0;
9489 /***********************************************************************
9491 ***********************************************************************/
9493 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9496 /* The frame of a currently visible tooltip, or null. */
9498 struct frame
*tip_frame
;
9500 /* If non-nil, a timer started that hides the last tooltip when it
9503 Lisp_Object tip_timer
;
9506 /* Create a frame for a tooltip on the display described by DPYINFO.
9507 PARMS is a list of frame parameters. Value is the frame. */
9510 x_create_tip_frame (dpyinfo
, parms
)
9511 struct x_display_info
*dpyinfo
;
9515 Lisp_Object frame
, tem
;
9517 long window_prompting
= 0;
9519 int count
= specpdl_ptr
- specpdl
;
9520 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9525 /* Use this general default value to start with until we know if
9526 this frame has a specified name. */
9527 Vx_resource_name
= Vinvocation_name
;
9530 kb
= dpyinfo
->kboard
;
9532 kb
= &the_only_kboard
;
9535 /* Get the name of the frame to use for resource lookup. */
9536 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9538 && !EQ (name
, Qunbound
)
9540 error ("Invalid frame name--not a string or nil");
9541 Vx_resource_name
= name
;
9544 GCPRO3 (parms
, name
, frame
);
9545 tip_frame
= f
= make_frame (1);
9546 XSETFRAME (frame
, f
);
9547 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9549 f
->output_method
= output_x_window
;
9550 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9551 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9552 f
->output_data
.x
->icon_bitmap
= -1;
9553 f
->output_data
.x
->fontset
= -1;
9554 f
->icon_name
= Qnil
;
9555 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9557 FRAME_KBOARD (f
) = kb
;
9559 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9560 f
->output_data
.x
->explicit_parent
= 0;
9562 /* Set the name; the functions to which we pass f expect the name to
9564 if (EQ (name
, Qunbound
) || NILP (name
))
9566 f
->name
= build_string (dpyinfo
->x_id_name
);
9567 f
->explicit_name
= 0;
9572 f
->explicit_name
= 1;
9573 /* use the frame's title when getting resources for this frame. */
9574 specbind (Qx_resource_name
, name
);
9577 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9578 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9579 fs_register_fontset (f
, XCAR (tem
));
9581 /* Extract the window parameters from the supplied values
9582 that are needed to determine window geometry. */
9586 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9589 /* First, try whatever font the caller has specified. */
9592 tem
= Fquery_fontset (font
, Qnil
);
9594 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9596 font
= x_new_font (f
, XSTRING (font
)->data
);
9599 /* Try out a font which we hope has bold and italic variations. */
9600 if (!STRINGP (font
))
9601 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9602 if (!STRINGP (font
))
9603 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9604 if (! STRINGP (font
))
9605 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9606 if (! STRINGP (font
))
9607 /* This was formerly the first thing tried, but it finds too many fonts
9608 and takes too long. */
9609 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9610 /* If those didn't work, look for something which will at least work. */
9611 if (! STRINGP (font
))
9612 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9614 if (! STRINGP (font
))
9615 font
= build_string ("fixed");
9617 x_default_parameter (f
, parms
, Qfont
, font
,
9618 "font", "Font", RES_TYPE_STRING
);
9621 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9622 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9624 /* This defaults to 2 in order to match xterm. We recognize either
9625 internalBorderWidth or internalBorder (which is what xterm calls
9627 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9631 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9632 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9633 if (! EQ (value
, Qunbound
))
9634 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9638 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9639 "internalBorderWidth", "internalBorderWidth",
9642 /* Also do the stuff which must be set before the window exists. */
9643 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9644 "foreground", "Foreground", RES_TYPE_STRING
);
9645 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9646 "background", "Background", RES_TYPE_STRING
);
9647 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9648 "pointerColor", "Foreground", RES_TYPE_STRING
);
9649 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9650 "cursorColor", "Foreground", RES_TYPE_STRING
);
9651 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9652 "borderColor", "BorderColor", RES_TYPE_STRING
);
9654 /* Init faces before x_default_parameter is called for scroll-bar
9655 parameters because that function calls x_set_scroll_bar_width,
9656 which calls change_frame_size, which calls Fset_window_buffer,
9657 which runs hooks, which call Fvertical_motion. At the end, we
9658 end up in init_iterator with a null face cache, which should not
9660 init_frame_faces (f
);
9662 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9663 window_prompting
= x_figure_window_size (f
, parms
);
9665 if (window_prompting
& XNegative
)
9667 if (window_prompting
& YNegative
)
9668 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9670 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9674 if (window_prompting
& YNegative
)
9675 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9677 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9680 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9682 XSetWindowAttributes attrs
;
9686 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9687 /* Window managers looks at the override-redirect flag to
9688 determine whether or net to give windows a decoration (Xlib
9690 attrs
.override_redirect
= True
;
9691 attrs
.save_under
= True
;
9692 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9693 /* Arrange for getting MapNotify and UnmapNotify events. */
9694 attrs
.event_mask
= StructureNotifyMask
;
9696 = FRAME_X_WINDOW (f
)
9697 = XCreateWindow (FRAME_X_DISPLAY (f
),
9698 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9699 /* x, y, width, height */
9703 CopyFromParent
, InputOutput
, CopyFromParent
,
9710 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9711 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9712 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9713 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9714 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9715 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9717 /* Dimensions, especially f->height, must be done via change_frame_size.
9718 Change will not be effected unless different from the current
9723 SET_FRAME_WIDTH (f
, 0);
9724 change_frame_size (f
, height
, width
, 1, 0, 0);
9730 /* It is now ok to make the frame official even if we get an error
9731 below. And the frame needs to be on Vframe_list or making it
9732 visible won't work. */
9733 Vframe_list
= Fcons (frame
, Vframe_list
);
9735 /* Now that the frame is official, it counts as a reference to
9737 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9739 return unbind_to (count
, frame
);
9743 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9744 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9745 A tooltip window is a small X window displaying STRING at\n\
9746 the current mouse position.\n\
9747 FRAME nil or omitted means use the selected frame.\n\
9748 PARMS is an optional list of frame parameters which can be\n\
9749 used to change the tooltip's appearance.\n\
9750 Automatically hide the tooltip after TIMEOUT seconds.\n\
9751 TIMEOUT nil means use the default timeout of 5 seconds.")
9752 (string
, frame
, parms
, timeout
)
9753 Lisp_Object string
, frame
, parms
;
9759 struct buffer
*old_buffer
;
9760 struct text_pos pos
;
9761 int i
, width
, height
;
9762 int root_x
, root_y
, win_x
, win_y
;
9764 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9765 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9766 int count
= specpdl_ptr
- specpdl
;
9768 specbind (Qinhibit_redisplay
, Qt
);
9770 GCPRO3 (string
, parms
, frame
);
9772 CHECK_STRING (string
, 0);
9773 f
= check_x_frame (frame
);
9775 timeout
= make_number (5);
9777 CHECK_NATNUM (timeout
, 2);
9779 /* Hide a previous tip, if any. */
9782 /* Add default values to frame parameters. */
9783 if (NILP (Fassq (Qname
, parms
)))
9784 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9785 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9786 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9787 if (NILP (Fassq (Qborder_width
, parms
)))
9788 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9789 if (NILP (Fassq (Qborder_color
, parms
)))
9790 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9791 if (NILP (Fassq (Qbackground_color
, parms
)))
9792 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9795 /* Create a frame for the tooltip, and record it in the global
9796 variable tip_frame. */
9797 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9798 tip_frame
= f
= XFRAME (frame
);
9800 /* Set up the frame's root window. Currently we use a size of 80
9801 columns x 40 lines. If someone wants to show a larger tip, he
9802 will loose. I don't think this is a realistic case. */
9803 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9804 w
->left
= w
->top
= make_number (0);
9808 w
->pseudo_window_p
= 1;
9810 /* Display the tooltip text in a temporary buffer. */
9811 buffer
= Fget_buffer_create (build_string (" *tip*"));
9812 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9813 old_buffer
= current_buffer
;
9814 set_buffer_internal_1 (XBUFFER (buffer
));
9816 Finsert (make_number (1), &string
);
9817 clear_glyph_matrix (w
->desired_matrix
);
9818 clear_glyph_matrix (w
->current_matrix
);
9819 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9820 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9822 /* Compute width and height of the tooltip. */
9824 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9826 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9830 /* Stop at the first empty row at the end. */
9831 if (!row
->enabled_p
|| !row
->displays_text_p
)
9834 /* Let the row go over the full width of the frame. */
9835 row
->full_width_p
= 1;
9837 /* There's a glyph at the end of rows that is use to place
9838 the cursor there. Don't include the width of this glyph. */
9839 if (row
->used
[TEXT_AREA
])
9841 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9842 row_width
= row
->pixel_width
- last
->pixel_width
;
9845 row_width
= row
->pixel_width
;
9847 height
+= row
->height
;
9848 width
= max (width
, row_width
);
9851 /* Add the frame's internal border to the width and height the X
9852 window should have. */
9853 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9854 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9856 /* Move the tooltip window where the mouse pointer is. Resize and
9859 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9860 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9861 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9862 root_x
+ 5, root_y
- height
- 5, width
, height
);
9863 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9866 /* Draw into the window. */
9867 w
->must_be_updated_p
= 1;
9868 update_single_window (w
, 1);
9870 /* Restore original current buffer. */
9871 set_buffer_internal_1 (old_buffer
);
9872 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9874 /* Let the tip disappear after timeout seconds. */
9875 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9876 intern ("x-hide-tip"));
9878 return unbind_to (count
, Qnil
);
9882 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9883 "Hide the current tooltip window, if there is any.\n\
9884 Value is t is tooltip was open, nil otherwise.")
9887 int count
= specpdl_ptr
- specpdl
;
9890 specbind (Qinhibit_redisplay
, Qt
);
9892 if (!NILP (tip_timer
))
9894 call1 (intern ("cancel-timer"), tip_timer
);
9902 XSETFRAME (frame
, tip_frame
);
9903 Fdelete_frame (frame
, Qt
);
9908 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9913 /***********************************************************************
9914 File selection dialog
9915 ***********************************************************************/
9919 /* Callback for "OK" and "Cancel" on file selection dialog. */
9922 file_dialog_cb (widget
, client_data
, call_data
)
9924 XtPointer call_data
, client_data
;
9926 int *result
= (int *) client_data
;
9927 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9928 *result
= cb
->reason
;
9932 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9933 "Read file name, prompting with PROMPT in directory DIR.\n\
9934 Use a file selection dialog.\n\
9935 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9936 specified. Don't let the user enter a file name in the file\n\
9937 selection dialog's entry field, if MUSTMATCH is non-nil.")
9938 (prompt
, dir
, default_filename
, mustmatch
)
9939 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9942 struct frame
*f
= SELECTED_FRAME ();
9943 Lisp_Object file
= Qnil
;
9944 Widget dialog
, text
, list
, help
;
9947 extern XtAppContext Xt_app_con
;
9949 XmString dir_xmstring
, pattern_xmstring
;
9950 int popup_activated_flag
;
9951 int count
= specpdl_ptr
- specpdl
;
9952 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9954 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9955 CHECK_STRING (prompt
, 0);
9956 CHECK_STRING (dir
, 1);
9958 /* Prevent redisplay. */
9959 specbind (Qinhibit_redisplay
, Qt
);
9963 /* Create the dialog with PROMPT as title, using DIR as initial
9964 directory and using "*" as pattern. */
9965 dir
= Fexpand_file_name (dir
, Qnil
);
9966 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9967 pattern_xmstring
= XmStringCreateLocalized ("*");
9969 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9970 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9971 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9972 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9973 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9974 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9976 XmStringFree (dir_xmstring
);
9977 XmStringFree (pattern_xmstring
);
9979 /* Add callbacks for OK and Cancel. */
9980 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9981 (XtPointer
) &result
);
9982 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9983 (XtPointer
) &result
);
9985 /* Disable the help button since we can't display help. */
9986 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9987 XtSetSensitive (help
, False
);
9989 /* Mark OK button as default. */
9990 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
9991 XmNshowAsDefault
, True
, NULL
);
9993 /* If MUSTMATCH is non-nil, disable the file entry field of the
9994 dialog, so that the user must select a file from the files list
9995 box. We can't remove it because we wouldn't have a way to get at
9996 the result file name, then. */
9997 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
9998 if (!NILP (mustmatch
))
10001 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10002 XtSetSensitive (text
, False
);
10003 XtSetSensitive (label
, False
);
10006 /* Manage the dialog, so that list boxes get filled. */
10007 XtManageChild (dialog
);
10009 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10010 must include the path for this to work. */
10011 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10012 if (STRINGP (default_filename
))
10014 XmString default_xmstring
;
10018 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10020 if (!XmListItemExists (list
, default_xmstring
))
10022 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10023 XmListAddItem (list
, default_xmstring
, 0);
10027 item_pos
= XmListItemPos (list
, default_xmstring
);
10028 XmStringFree (default_xmstring
);
10030 /* Select the item and scroll it into view. */
10031 XmListSelectPos (list
, item_pos
, True
);
10032 XmListSetPos (list
, item_pos
);
10035 /* Process all events until the user presses Cancel or OK. */
10036 for (result
= 0; result
== 0;)
10039 Widget widget
, parent
;
10041 XtAppNextEvent (Xt_app_con
, &event
);
10043 /* See if the receiver of the event is one of the widgets of
10044 the file selection dialog. If so, dispatch it. If not,
10046 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10048 while (parent
&& parent
!= dialog
)
10049 parent
= XtParent (parent
);
10051 if (parent
== dialog
10052 || (event
.type
== Expose
10053 && !process_expose_from_menu (event
)))
10054 XtDispatchEvent (&event
);
10057 /* Get the result. */
10058 if (result
== XmCR_OK
)
10063 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10064 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10065 XmStringFree (text
);
10066 file
= build_string (data
);
10073 XtUnmanageChild (dialog
);
10074 XtDestroyWidget (dialog
);
10078 /* Make "Cancel" equivalent to C-g. */
10080 Fsignal (Qquit
, Qnil
);
10082 return unbind_to (count
, file
);
10085 #endif /* USE_MOTIF */
10088 /***********************************************************************
10090 ***********************************************************************/
10094 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10095 "Value is non-nil if SPEC is a valid image specification.")
10099 return valid_image_p (spec
) ? Qt
: Qnil
;
10103 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10109 if (valid_image_p (spec
))
10110 id
= lookup_image (SELECTED_FRAME (), spec
);
10112 debug_print (spec
);
10113 return make_number (id
);
10116 #endif /* GLYPH_DEBUG != 0 */
10120 /***********************************************************************
10122 ***********************************************************************/
10127 /* This is zero if not using X windows. */
10130 /* The section below is built by the lisp expression at the top of the file,
10131 just above where these variables are declared. */
10132 /*&&& init symbols here &&&*/
10133 Qauto_raise
= intern ("auto-raise");
10134 staticpro (&Qauto_raise
);
10135 Qauto_lower
= intern ("auto-lower");
10136 staticpro (&Qauto_lower
);
10137 Qbar
= intern ("bar");
10139 Qborder_color
= intern ("border-color");
10140 staticpro (&Qborder_color
);
10141 Qborder_width
= intern ("border-width");
10142 staticpro (&Qborder_width
);
10143 Qbox
= intern ("box");
10145 Qcursor_color
= intern ("cursor-color");
10146 staticpro (&Qcursor_color
);
10147 Qcursor_type
= intern ("cursor-type");
10148 staticpro (&Qcursor_type
);
10149 Qgeometry
= intern ("geometry");
10150 staticpro (&Qgeometry
);
10151 Qicon_left
= intern ("icon-left");
10152 staticpro (&Qicon_left
);
10153 Qicon_top
= intern ("icon-top");
10154 staticpro (&Qicon_top
);
10155 Qicon_type
= intern ("icon-type");
10156 staticpro (&Qicon_type
);
10157 Qicon_name
= intern ("icon-name");
10158 staticpro (&Qicon_name
);
10159 Qinternal_border_width
= intern ("internal-border-width");
10160 staticpro (&Qinternal_border_width
);
10161 Qleft
= intern ("left");
10162 staticpro (&Qleft
);
10163 Qright
= intern ("right");
10164 staticpro (&Qright
);
10165 Qmouse_color
= intern ("mouse-color");
10166 staticpro (&Qmouse_color
);
10167 Qnone
= intern ("none");
10168 staticpro (&Qnone
);
10169 Qparent_id
= intern ("parent-id");
10170 staticpro (&Qparent_id
);
10171 Qscroll_bar_width
= intern ("scroll-bar-width");
10172 staticpro (&Qscroll_bar_width
);
10173 Qsuppress_icon
= intern ("suppress-icon");
10174 staticpro (&Qsuppress_icon
);
10175 Qundefined_color
= intern ("undefined-color");
10176 staticpro (&Qundefined_color
);
10177 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10178 staticpro (&Qvertical_scroll_bars
);
10179 Qvisibility
= intern ("visibility");
10180 staticpro (&Qvisibility
);
10181 Qwindow_id
= intern ("window-id");
10182 staticpro (&Qwindow_id
);
10183 Qouter_window_id
= intern ("outer-window-id");
10184 staticpro (&Qouter_window_id
);
10185 Qx_frame_parameter
= intern ("x-frame-parameter");
10186 staticpro (&Qx_frame_parameter
);
10187 Qx_resource_name
= intern ("x-resource-name");
10188 staticpro (&Qx_resource_name
);
10189 Quser_position
= intern ("user-position");
10190 staticpro (&Quser_position
);
10191 Quser_size
= intern ("user-size");
10192 staticpro (&Quser_size
);
10193 Qdisplay
= intern ("display");
10194 staticpro (&Qdisplay
);
10195 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10196 staticpro (&Qscroll_bar_foreground
);
10197 Qscroll_bar_background
= intern ("scroll-bar-background");
10198 staticpro (&Qscroll_bar_background
);
10199 Qscreen_gamma
= intern ("screen-gamma");
10200 staticpro (&Qscreen_gamma
);
10201 /* This is the end of symbol initialization. */
10203 Qlaplace
= intern ("laplace");
10204 staticpro (&Qlaplace
);
10206 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10207 staticpro (&Qface_set_after_frame_default
);
10209 Fput (Qundefined_color
, Qerror_conditions
,
10210 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10211 Fput (Qundefined_color
, Qerror_message
,
10212 build_string ("Undefined color"));
10214 init_x_parm_symbols ();
10216 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10217 "List of directories to search for bitmap files for X.");
10218 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10220 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10221 "The shape of the pointer when over text.\n\
10222 Changing the value does not affect existing frames\n\
10223 unless you set the mouse color.");
10224 Vx_pointer_shape
= Qnil
;
10226 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10227 "The name Emacs uses to look up X resources.\n\
10228 `x-get-resource' uses this as the first component of the instance name\n\
10229 when requesting resource values.\n\
10230 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10231 was invoked, or to the value specified with the `-name' or `-rn'\n\
10232 switches, if present.\n\
10234 It may be useful to bind this variable locally around a call\n\
10235 to `x-get-resource'. See also the variable `x-resource-class'.");
10236 Vx_resource_name
= Qnil
;
10238 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10239 "The class Emacs uses to look up X resources.\n\
10240 `x-get-resource' uses this as the first component of the instance class\n\
10241 when requesting resource values.\n\
10242 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10244 Setting this variable permanently is not a reasonable thing to do,\n\
10245 but binding this variable locally around a call to `x-get-resource'\n\
10246 is a reasonable practice. See also the variable `x-resource-name'.");
10247 Vx_resource_class
= build_string (EMACS_CLASS
);
10249 #if 0 /* This doesn't really do anything. */
10250 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10251 "The shape of the pointer when not over text.\n\
10252 This variable takes effect when you create a new frame\n\
10253 or when you set the mouse color.");
10255 Vx_nontext_pointer_shape
= Qnil
;
10257 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10258 "The shape of the pointer when Emacs is busy.\n\
10259 This variable takes effect when you create a new frame\n\
10260 or when you set the mouse color.");
10261 Vx_busy_pointer_shape
= Qnil
;
10263 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10264 "Non-zero means Emacs displays a busy cursor on window systems.");
10265 display_busy_cursor_p
= 1;
10267 #if 0 /* This doesn't really do anything. */
10268 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10269 "The shape of the pointer when over the mode line.\n\
10270 This variable takes effect when you create a new frame\n\
10271 or when you set the mouse color.");
10273 Vx_mode_pointer_shape
= Qnil
;
10275 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10276 &Vx_sensitive_text_pointer_shape
,
10277 "The shape of the pointer when over mouse-sensitive text.\n\
10278 This variable takes effect when you create a new frame\n\
10279 or when you set the mouse color.");
10280 Vx_sensitive_text_pointer_shape
= Qnil
;
10282 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10283 "A string indicating the foreground color of the cursor box.");
10284 Vx_cursor_fore_pixel
= Qnil
;
10286 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10287 "Non-nil if no X window manager is in use.\n\
10288 Emacs doesn't try to figure this out; this is always nil\n\
10289 unless you set it to something else.");
10290 /* We don't have any way to find this out, so set it to nil
10291 and maybe the user would like to set it to t. */
10292 Vx_no_window_manager
= Qnil
;
10294 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10295 &Vx_pixel_size_width_font_regexp
,
10296 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10298 Since Emacs gets width of a font matching with this regexp from\n\
10299 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10300 such a font. This is especially effective for such large fonts as\n\
10301 Chinese, Japanese, and Korean.");
10302 Vx_pixel_size_width_font_regexp
= Qnil
;
10304 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10305 "Time after which cached images are removed from the cache.\n\
10306 When an image has not been displayed this many seconds, remove it\n\
10307 from the image cache. Value must be an integer or nil with nil\n\
10308 meaning don't clear the cache.");
10309 Vimage_cache_eviction_delay
= make_number (30 * 60);
10311 DEFVAR_LISP ("image-types", &Vimage_types
,
10312 "List of supported image types.\n\
10313 Each element of the list is a symbol for a supported image type.");
10314 Vimage_types
= Qnil
;
10316 #ifdef USE_X_TOOLKIT
10317 Fprovide (intern ("x-toolkit"));
10320 Fprovide (intern ("motif"));
10323 defsubr (&Sx_get_resource
);
10325 /* X window properties. */
10326 defsubr (&Sx_change_window_property
);
10327 defsubr (&Sx_delete_window_property
);
10328 defsubr (&Sx_window_property
);
10331 defsubr (&Sx_draw_rectangle
);
10332 defsubr (&Sx_erase_rectangle
);
10333 defsubr (&Sx_contour_region
);
10334 defsubr (&Sx_uncontour_region
);
10336 defsubr (&Sx_display_color_p
);
10337 defsubr (&Sx_display_grayscale_p
);
10338 defsubr (&Sx_color_defined_p
);
10339 defsubr (&Sx_color_values
);
10340 defsubr (&Sx_server_max_request_size
);
10341 defsubr (&Sx_server_vendor
);
10342 defsubr (&Sx_server_version
);
10343 defsubr (&Sx_display_pixel_width
);
10344 defsubr (&Sx_display_pixel_height
);
10345 defsubr (&Sx_display_mm_width
);
10346 defsubr (&Sx_display_mm_height
);
10347 defsubr (&Sx_display_screens
);
10348 defsubr (&Sx_display_planes
);
10349 defsubr (&Sx_display_color_cells
);
10350 defsubr (&Sx_display_visual_class
);
10351 defsubr (&Sx_display_backing_store
);
10352 defsubr (&Sx_display_save_under
);
10354 defsubr (&Sx_rebind_key
);
10355 defsubr (&Sx_rebind_keys
);
10356 defsubr (&Sx_track_pointer
);
10357 defsubr (&Sx_grab_pointer
);
10358 defsubr (&Sx_ungrab_pointer
);
10360 defsubr (&Sx_parse_geometry
);
10361 defsubr (&Sx_create_frame
);
10363 defsubr (&Sx_horizontal_line
);
10365 defsubr (&Sx_open_connection
);
10366 defsubr (&Sx_close_connection
);
10367 defsubr (&Sx_display_list
);
10368 defsubr (&Sx_synchronize
);
10370 /* Setting callback functions for fontset handler. */
10371 get_font_info_func
= x_get_font_info
;
10373 #if 0 /* This function pointer doesn't seem to be used anywhere.
10374 And the pointer assigned has the wrong type, anyway. */
10375 list_fonts_func
= x_list_fonts
;
10378 load_font_func
= x_load_font
;
10379 find_ccl_program_func
= x_find_ccl_program
;
10380 query_font_func
= x_query_font
;
10381 set_frame_fontset_func
= x_set_font
;
10382 check_window_system_func
= check_x
;
10385 Qxbm
= intern ("xbm");
10387 QCtype
= intern (":type");
10388 staticpro (&QCtype
);
10389 QCalgorithm
= intern (":algorithm");
10390 staticpro (&QCalgorithm
);
10391 QCheuristic_mask
= intern (":heuristic-mask");
10392 staticpro (&QCheuristic_mask
);
10393 QCcolor_symbols
= intern (":color-symbols");
10394 staticpro (&QCcolor_symbols
);
10395 QCdata
= intern (":data");
10396 staticpro (&QCdata
);
10397 QCascent
= intern (":ascent");
10398 staticpro (&QCascent
);
10399 QCmargin
= intern (":margin");
10400 staticpro (&QCmargin
);
10401 QCrelief
= intern (":relief");
10402 staticpro (&QCrelief
);
10403 Qpostscript
= intern ("postscript");
10404 staticpro (&Qpostscript
);
10405 QCloader
= intern (":loader");
10406 staticpro (&QCloader
);
10407 QCbounding_box
= intern (":bounding-box");
10408 staticpro (&QCbounding_box
);
10409 QCpt_width
= intern (":pt-width");
10410 staticpro (&QCpt_width
);
10411 QCpt_height
= intern (":pt-height");
10412 staticpro (&QCpt_height
);
10413 QCindex
= intern (":index");
10414 staticpro (&QCindex
);
10415 Qpbm
= intern ("pbm");
10419 Qxpm
= intern ("xpm");
10424 Qjpeg
= intern ("jpeg");
10425 staticpro (&Qjpeg
);
10429 Qtiff
= intern ("tiff");
10430 staticpro (&Qtiff
);
10434 Qgif
= intern ("gif");
10439 Qpng
= intern ("png");
10443 defsubr (&Sclear_image_cache
);
10446 defsubr (&Simagep
);
10447 defsubr (&Slookup_image
);
10451 defsubr (&Sx_show_busy_cursor
);
10452 defsubr (&Sx_hide_busy_cursor
);
10454 inhibit_busy_cursor
= 0;
10456 defsubr (&Sx_show_tip
);
10457 defsubr (&Sx_hide_tip
);
10458 staticpro (&tip_timer
);
10462 defsubr (&Sx_file_dialog
);
10470 image_types
= NULL
;
10471 Vimage_types
= Qnil
;
10473 define_image_type (&xbm_type
);
10474 define_image_type (&gs_type
);
10475 define_image_type (&pbm_type
);
10478 define_image_type (&xpm_type
);
10482 define_image_type (&jpeg_type
);
10486 define_image_type (&tiff_type
);
10490 define_image_type (&gif_type
);
10494 define_image_type (&png_type
);
10498 #endif /* HAVE_X_WINDOWS */