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
)
300 CHECK_LIVE_FRAME (frame
, 0);
304 error ("Non-X frame used");
308 /* Let the user specify an X display with a frame.
309 nil stands for the selected frame--or, if that is not an X frame,
310 the first X display on the list. */
312 static struct x_display_info
*
313 check_x_display_info (frame
)
318 if (FRAME_X_P (selected_frame
)
319 && FRAME_LIVE_P (selected_frame
))
320 return FRAME_X_DISPLAY_INFO (selected_frame
);
321 else if (x_display_list
!= 0)
322 return x_display_list
;
324 error ("X windows are not in use or not initialized");
326 else if (STRINGP (frame
))
327 return x_display_info_for_name (frame
);
332 CHECK_LIVE_FRAME (frame
, 0);
335 error ("Non-X frame used");
336 return FRAME_X_DISPLAY_INFO (f
);
341 /* Return the Emacs frame-object corresponding to an X window.
342 It could be the frame's main window or an icon window. */
344 /* This function can be called during GC, so use GC_xxx type test macros. */
347 x_window_to_frame (dpyinfo
, wdesc
)
348 struct x_display_info
*dpyinfo
;
351 Lisp_Object tail
, frame
;
354 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
356 frame
= XCONS (tail
)->car
;
357 if (!GC_FRAMEP (frame
))
360 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
363 if ((f
->output_data
.x
->edit_widget
364 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
365 /* A tooltip frame? */
366 || (!f
->output_data
.x
->edit_widget
367 && FRAME_X_WINDOW (f
) == wdesc
)
368 || f
->output_data
.x
->icon_desc
== wdesc
)
370 #else /* not USE_X_TOOLKIT */
371 if (FRAME_X_WINDOW (f
) == wdesc
372 || f
->output_data
.x
->icon_desc
== wdesc
)
374 #endif /* not USE_X_TOOLKIT */
380 /* Like x_window_to_frame but also compares the window with the widget's
384 x_any_window_to_frame (dpyinfo
, wdesc
)
385 struct x_display_info
*dpyinfo
;
388 Lisp_Object tail
, frame
;
392 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
394 frame
= XCONS (tail
)->car
;
395 if (!GC_FRAMEP (frame
))
398 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
400 x
= f
->output_data
.x
;
401 /* This frame matches if the window is any of its widgets. */
404 if (wdesc
== XtWindow (x
->widget
)
405 || wdesc
== XtWindow (x
->column_widget
)
406 || wdesc
== XtWindow (x
->edit_widget
))
408 /* Match if the window is this frame's menubar. */
409 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
412 else if (FRAME_X_WINDOW (f
) == wdesc
)
413 /* A tooltip frame. */
419 /* Likewise, but exclude the menu bar widget. */
422 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
423 struct x_display_info
*dpyinfo
;
426 Lisp_Object tail
, frame
;
430 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
432 frame
= XCONS (tail
)->car
;
433 if (!GC_FRAMEP (frame
))
436 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
438 x
= f
->output_data
.x
;
439 /* This frame matches if the window is any of its widgets. */
442 if (wdesc
== XtWindow (x
->widget
)
443 || wdesc
== XtWindow (x
->column_widget
)
444 || wdesc
== XtWindow (x
->edit_widget
))
447 else if (FRAME_X_WINDOW (f
) == wdesc
)
448 /* A tooltip frame. */
454 /* Likewise, but consider only the menu bar widget. */
457 x_menubar_window_to_frame (dpyinfo
, wdesc
)
458 struct x_display_info
*dpyinfo
;
461 Lisp_Object tail
, frame
;
465 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
467 frame
= XCONS (tail
)->car
;
468 if (!GC_FRAMEP (frame
))
471 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
473 x
= f
->output_data
.x
;
474 /* Match if the window is this frame's menubar. */
475 if (x
->menubar_widget
476 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
482 /* Return the frame whose principal (outermost) window is WDESC.
483 If WDESC is some other (smaller) window, we return 0. */
486 x_top_window_to_frame (dpyinfo
, wdesc
)
487 struct x_display_info
*dpyinfo
;
490 Lisp_Object tail
, frame
;
494 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
496 frame
= XCONS (tail
)->car
;
497 if (!GC_FRAMEP (frame
))
500 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
502 x
= f
->output_data
.x
;
506 /* This frame matches if the window is its topmost widget. */
507 if (wdesc
== XtWindow (x
->widget
))
509 #if 0 /* I don't know why it did this,
510 but it seems logically wrong,
511 and it causes trouble for MapNotify events. */
512 /* Match if the window is this frame's menubar. */
513 if (x
->menubar_widget
514 && wdesc
== XtWindow (x
->menubar_widget
))
518 else if (FRAME_X_WINDOW (f
) == wdesc
)
524 #endif /* USE_X_TOOLKIT */
528 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
529 id, which is just an int that this section returns. Bitmaps are
530 reference counted so they can be shared among frames.
532 Bitmap indices are guaranteed to be > 0, so a negative number can
533 be used to indicate no bitmap.
535 If you use x_create_bitmap_from_data, then you must keep track of
536 the bitmaps yourself. That is, creating a bitmap from the same
537 data more than once will not be caught. */
540 /* Functions to access the contents of a bitmap, given an id. */
543 x_bitmap_height (f
, id
)
547 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
551 x_bitmap_width (f
, id
)
555 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
559 x_bitmap_pixmap (f
, id
)
563 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
567 /* Allocate a new bitmap record. Returns index of new record. */
570 x_allocate_bitmap_record (f
)
573 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
576 if (dpyinfo
->bitmaps
== NULL
)
578 dpyinfo
->bitmaps_size
= 10;
580 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
581 dpyinfo
->bitmaps_last
= 1;
585 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
586 return ++dpyinfo
->bitmaps_last
;
588 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
589 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
592 dpyinfo
->bitmaps_size
*= 2;
594 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
595 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
596 return ++dpyinfo
->bitmaps_last
;
599 /* Add one reference to the reference count of the bitmap with id ID. */
602 x_reference_bitmap (f
, id
)
606 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
609 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
612 x_create_bitmap_from_data (f
, bits
, width
, height
)
615 unsigned int width
, height
;
617 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
621 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
622 bits
, width
, height
);
627 id
= x_allocate_bitmap_record (f
);
628 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
629 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
630 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
631 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
632 dpyinfo
->bitmaps
[id
- 1].height
= height
;
633 dpyinfo
->bitmaps
[id
- 1].width
= width
;
638 /* Create bitmap from file FILE for frame F. */
641 x_create_bitmap_from_file (f
, file
)
645 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
646 unsigned int width
, height
;
648 int xhot
, yhot
, result
, id
;
653 /* Look for an existing bitmap with the same name. */
654 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
656 if (dpyinfo
->bitmaps
[id
].refcount
657 && dpyinfo
->bitmaps
[id
].file
658 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
660 ++dpyinfo
->bitmaps
[id
].refcount
;
665 /* Search bitmap-file-path for the file, if appropriate. */
666 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
669 /* XReadBitmapFile won't handle magic file names. */
674 filename
= (char *) XSTRING (found
)->data
;
676 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
677 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
678 if (result
!= BitmapSuccess
)
681 id
= x_allocate_bitmap_record (f
);
682 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
683 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
684 dpyinfo
->bitmaps
[id
- 1].file
685 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
686 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
687 dpyinfo
->bitmaps
[id
- 1].height
= height
;
688 dpyinfo
->bitmaps
[id
- 1].width
= width
;
689 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
694 /* Remove reference to bitmap with id number ID. */
697 x_destroy_bitmap (f
, id
)
701 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
705 --dpyinfo
->bitmaps
[id
- 1].refcount
;
706 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
709 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
710 if (dpyinfo
->bitmaps
[id
- 1].file
)
712 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
713 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
720 /* Free all the bitmaps for the display specified by DPYINFO. */
723 x_destroy_all_bitmaps (dpyinfo
)
724 struct x_display_info
*dpyinfo
;
727 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
728 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
730 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
731 if (dpyinfo
->bitmaps
[i
].file
)
732 xfree (dpyinfo
->bitmaps
[i
].file
);
734 dpyinfo
->bitmaps_last
= 0;
737 /* Connect the frame-parameter names for X frames
738 to the ways of passing the parameter values to the window system.
740 The name of a parameter, as a Lisp symbol,
741 has an `x-frame-parameter' property which is an integer in Lisp
742 that is an index in this table. */
744 struct x_frame_parm_table
747 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
762 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
767 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
770 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
771 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
775 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
777 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
782 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
784 static struct x_frame_parm_table x_frame_parms
[] =
786 "auto-raise", x_set_autoraise
,
787 "auto-lower", x_set_autolower
,
788 "background-color", x_set_background_color
,
789 "border-color", x_set_border_color
,
790 "border-width", x_set_border_width
,
791 "cursor-color", x_set_cursor_color
,
792 "cursor-type", x_set_cursor_type
,
794 "foreground-color", x_set_foreground_color
,
795 "icon-name", x_set_icon_name
,
796 "icon-type", x_set_icon_type
,
797 "internal-border-width", x_set_internal_border_width
,
798 "menu-bar-lines", x_set_menu_bar_lines
,
799 "mouse-color", x_set_mouse_color
,
800 "name", x_explicitly_set_name
,
801 "scroll-bar-width", x_set_scroll_bar_width
,
802 "title", x_set_title
,
803 "unsplittable", x_set_unsplittable
,
804 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
805 "visibility", x_set_visibility
,
806 "tool-bar-lines", x_set_tool_bar_lines
,
807 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
808 "scroll-bar-background", x_set_scroll_bar_background
,
809 "screen-gamma", x_set_screen_gamma
812 /* Attach the `x-frame-parameter' properties to
813 the Lisp symbol names of parameters relevant to X. */
816 init_x_parm_symbols ()
820 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
821 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
825 /* Change the parameters of frame F as specified by ALIST.
826 If a parameter is not specially recognized, do nothing;
827 otherwise call the `x_set_...' function for that parameter. */
830 x_set_frame_parameters (f
, alist
)
836 /* If both of these parameters are present, it's more efficient to
837 set them both at once. So we wait until we've looked at the
838 entire list before we set them. */
842 Lisp_Object left
, top
;
844 /* Same with these. */
845 Lisp_Object icon_left
, icon_top
;
847 /* Record in these vectors all the parms specified. */
851 int left_no_change
= 0, top_no_change
= 0;
852 int icon_left_no_change
= 0, icon_top_no_change
= 0;
854 struct gcpro gcpro1
, gcpro2
;
857 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
860 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
861 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
863 /* Extract parm names and values into those vectors. */
866 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
871 parms
[i
] = Fcar (elt
);
872 values
[i
] = Fcdr (elt
);
875 /* TAIL and ALIST are not used again below here. */
878 GCPRO2 (*parms
, *values
);
882 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
883 because their values appear in VALUES and strings are not valid. */
884 top
= left
= Qunbound
;
885 icon_left
= icon_top
= Qunbound
;
887 /* Provide default values for HEIGHT and WIDTH. */
888 if (FRAME_NEW_WIDTH (f
))
889 width
= FRAME_NEW_WIDTH (f
);
891 width
= FRAME_WIDTH (f
);
893 if (FRAME_NEW_HEIGHT (f
))
894 height
= FRAME_NEW_HEIGHT (f
);
896 height
= FRAME_HEIGHT (f
);
898 /* Process foreground_color and background_color before anything else.
899 They are independent of other properties, but other properties (e.g.,
900 cursor_color) are dependent upon them. */
901 for (p
= 0; p
< i
; p
++)
903 Lisp_Object prop
, val
;
907 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
909 register Lisp_Object param_index
, old_value
;
911 param_index
= Fget (prop
, Qx_frame_parameter
);
912 old_value
= get_frame_param (f
, prop
);
913 store_frame_param (f
, prop
, val
);
914 if (NATNUMP (param_index
)
915 && (XFASTINT (param_index
)
916 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
917 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
921 /* Now process them in reverse of specified order. */
922 for (i
--; i
>= 0; i
--)
924 Lisp_Object prop
, val
;
929 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
930 width
= XFASTINT (val
);
931 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
932 height
= XFASTINT (val
);
933 else if (EQ (prop
, Qtop
))
935 else if (EQ (prop
, Qleft
))
937 else if (EQ (prop
, Qicon_top
))
939 else if (EQ (prop
, Qicon_left
))
941 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
942 /* Processed above. */
946 register Lisp_Object param_index
, old_value
;
948 param_index
= Fget (prop
, Qx_frame_parameter
);
949 old_value
= get_frame_param (f
, prop
);
950 store_frame_param (f
, prop
, val
);
951 if (NATNUMP (param_index
)
952 && (XFASTINT (param_index
)
953 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
954 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
958 /* Don't die if just one of these was set. */
959 if (EQ (left
, Qunbound
))
962 if (f
->output_data
.x
->left_pos
< 0)
963 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
965 XSETINT (left
, f
->output_data
.x
->left_pos
);
967 if (EQ (top
, Qunbound
))
970 if (f
->output_data
.x
->top_pos
< 0)
971 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
973 XSETINT (top
, f
->output_data
.x
->top_pos
);
976 /* If one of the icon positions was not set, preserve or default it. */
977 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
979 icon_left_no_change
= 1;
980 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
981 if (NILP (icon_left
))
982 XSETINT (icon_left
, 0);
984 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
986 icon_top_no_change
= 1;
987 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
989 XSETINT (icon_top
, 0);
992 /* Don't set these parameters unless they've been explicitly
993 specified. The window might be mapped or resized while we're in
994 this function, and we don't want to override that unless the lisp
995 code has asked for it.
997 Don't set these parameters unless they actually differ from the
998 window's current parameters; the window may not actually exist
1003 check_frame_size (f
, &height
, &width
);
1005 XSETFRAME (frame
, f
);
1007 if (width
!= FRAME_WIDTH (f
)
1008 || height
!= FRAME_HEIGHT (f
)
1009 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1010 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1012 if ((!NILP (left
) || !NILP (top
))
1013 && ! (left_no_change
&& top_no_change
)
1014 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1015 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1020 /* Record the signs. */
1021 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1022 if (EQ (left
, Qminus
))
1023 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1024 else if (INTEGERP (left
))
1026 leftpos
= XINT (left
);
1028 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1030 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
1031 && CONSP (XCONS (left
)->cdr
)
1032 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
1034 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
1035 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1037 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
1038 && CONSP (XCONS (left
)->cdr
)
1039 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
1041 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
1044 if (EQ (top
, Qminus
))
1045 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1046 else if (INTEGERP (top
))
1048 toppos
= XINT (top
);
1050 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1052 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
1053 && CONSP (XCONS (top
)->cdr
)
1054 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
1056 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
1057 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1059 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
1060 && CONSP (XCONS (top
)->cdr
)
1061 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
1063 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
1067 /* Store the numeric value of the position. */
1068 f
->output_data
.x
->top_pos
= toppos
;
1069 f
->output_data
.x
->left_pos
= leftpos
;
1071 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1073 /* Actually set that position, and convert to absolute. */
1074 x_set_offset (f
, leftpos
, toppos
, -1);
1077 if ((!NILP (icon_left
) || !NILP (icon_top
))
1078 && ! (icon_left_no_change
&& icon_top_no_change
))
1079 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1085 /* Store the screen positions of frame F into XPTR and YPTR.
1086 These are the positions of the containing window manager window,
1087 not Emacs's own window. */
1090 x_real_positions (f
, xptr
, yptr
)
1097 /* This is pretty gross, but seems to be the easiest way out of
1098 the problem that arises when restarting window-managers. */
1100 #ifdef USE_X_TOOLKIT
1101 Window outer
= (f
->output_data
.x
->widget
1102 ? XtWindow (f
->output_data
.x
->widget
)
1103 : FRAME_X_WINDOW (f
));
1105 Window outer
= f
->output_data
.x
->window_desc
;
1107 Window tmp_root_window
;
1108 Window
*tmp_children
;
1113 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1114 Window outer_window
;
1116 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1117 &f
->output_data
.x
->parent_desc
,
1118 &tmp_children
, &tmp_nchildren
);
1119 XFree ((char *) tmp_children
);
1123 /* Find the position of the outside upper-left corner of
1124 the inner window, with respect to the outer window. */
1125 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1126 outer_window
= f
->output_data
.x
->parent_desc
;
1128 outer_window
= outer
;
1130 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1132 /* From-window, to-window. */
1134 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1136 /* From-position, to-position. */
1137 0, 0, &win_x
, &win_y
,
1142 /* It is possible for the window returned by the XQueryNotify
1143 to become invalid by the time we call XTranslateCoordinates.
1144 That can happen when you restart some window managers.
1145 If so, we get an error in XTranslateCoordinates.
1146 Detect that and try the whole thing over. */
1147 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1149 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1153 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1160 /* Insert a description of internally-recorded parameters of frame X
1161 into the parameter alist *ALISTPTR that is to be given to the user.
1162 Only parameters that are specific to the X window system
1163 and whose values are not correctly recorded in the frame's
1164 param_alist need to be considered here. */
1167 x_report_frame_params (f
, alistptr
)
1169 Lisp_Object
*alistptr
;
1174 /* Represent negative positions (off the top or left screen edge)
1175 in a way that Fmodify_frame_parameters will understand correctly. */
1176 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1177 if (f
->output_data
.x
->left_pos
>= 0)
1178 store_in_alist (alistptr
, Qleft
, tem
);
1180 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1182 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1183 if (f
->output_data
.x
->top_pos
>= 0)
1184 store_in_alist (alistptr
, Qtop
, tem
);
1186 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1188 store_in_alist (alistptr
, Qborder_width
,
1189 make_number (f
->output_data
.x
->border_width
));
1190 store_in_alist (alistptr
, Qinternal_border_width
,
1191 make_number (f
->output_data
.x
->internal_border_width
));
1192 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1193 store_in_alist (alistptr
, Qwindow_id
,
1194 build_string (buf
));
1195 #ifdef USE_X_TOOLKIT
1196 /* Tooltip frame may not have this widget. */
1197 if (f
->output_data
.x
->widget
)
1199 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1200 store_in_alist (alistptr
, Qouter_window_id
,
1201 build_string (buf
));
1202 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1203 FRAME_SAMPLE_VISIBILITY (f
);
1204 store_in_alist (alistptr
, Qvisibility
,
1205 (FRAME_VISIBLE_P (f
) ? Qt
1206 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1207 store_in_alist (alistptr
, Qdisplay
,
1208 XCONS (FRAME_X_DISPLAY_INFO (f
)->name_list_element
)->car
);
1210 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1213 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1214 store_in_alist (alistptr
, Qparent_id
, tem
);
1219 /* Gamma-correct COLOR on frame F. */
1222 gamma_correct (f
, color
)
1228 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1229 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1230 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1235 /* Decide if color named COLOR is valid for the display associated with
1236 the selected frame; if so, return the rgb values in COLOR_DEF.
1237 If ALLOC is nonzero, allocate a new colormap cell. */
1240 defined_color (f
, color
, color_def
, alloc
)
1246 register int status
;
1247 Colormap screen_colormap
;
1248 Display
*display
= FRAME_X_DISPLAY (f
);
1251 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1253 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1254 if (status
&& alloc
)
1256 /* Apply gamma correction. */
1257 gamma_correct (f
, color_def
);
1259 status
= XAllocColor (display
, screen_colormap
, color_def
);
1262 /* If we got to this point, the colormap is full, so we're
1263 going to try and get the next closest color.
1264 The algorithm used is a least-squares matching, which is
1265 what X uses for closest color matching with StaticColor visuals. */
1270 long nearest_delta
, trial_delta
;
1273 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1274 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1276 for (x
= 0; x
< no_cells
; x
++)
1279 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1281 /* I'm assuming CSE so I'm not going to condense this. */
1282 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1283 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1285 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1286 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1288 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1289 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1290 for (x
= 1; x
< no_cells
; x
++)
1292 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1293 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1295 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1296 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1298 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1299 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1300 if (trial_delta
< nearest_delta
)
1303 temp
.red
= cells
[x
].red
;
1304 temp
.green
= cells
[x
].green
;
1305 temp
.blue
= cells
[x
].blue
;
1306 status
= XAllocColor (display
, screen_colormap
, &temp
);
1310 nearest_delta
= trial_delta
;
1314 color_def
->red
= cells
[nearest
].red
;
1315 color_def
->green
= cells
[nearest
].green
;
1316 color_def
->blue
= cells
[nearest
].blue
;
1317 status
= XAllocColor (display
, screen_colormap
, color_def
);
1328 /* Given a string ARG naming a color, compute a pixel value from it
1329 suitable for screen F.
1330 If F is not a color screen, return DEF (default) regardless of what
1334 x_decode_color (f
, arg
, def
)
1341 CHECK_STRING (arg
, 0);
1343 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1344 return BLACK_PIX_DEFAULT (f
);
1345 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1346 return WHITE_PIX_DEFAULT (f
);
1348 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1351 /* defined_color is responsible for coping with failures
1352 by looking for a near-miss. */
1353 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1356 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1357 Fcons (arg
, Qnil
)));
1360 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1361 the previous value of that parameter, NEW_VALUE is the new value. */
1364 x_set_screen_gamma (f
, new_value
, old_value
)
1366 Lisp_Object new_value
, old_value
;
1368 if (NILP (new_value
))
1370 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1371 /* The value 0.4545 is the normal viewing gamma. */
1372 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1374 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1375 Fcons (new_value
, Qnil
)));
1377 clear_face_cache (0);
1381 /* Functions called only from `x_set_frame_param'
1382 to set individual parameters.
1384 If FRAME_X_WINDOW (f) is 0,
1385 the frame is being created and its X-window does not exist yet.
1386 In that case, just record the parameter's new value
1387 in the standard place; do not attempt to change the window. */
1390 x_set_foreground_color (f
, arg
, oldval
)
1392 Lisp_Object arg
, oldval
;
1395 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1397 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1398 f
->output_data
.x
->foreground_pixel
= pixel
;
1400 if (FRAME_X_WINDOW (f
) != 0)
1403 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1404 f
->output_data
.x
->foreground_pixel
);
1405 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1406 f
->output_data
.x
->foreground_pixel
);
1408 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1409 if (FRAME_VISIBLE_P (f
))
1415 x_set_background_color (f
, arg
, oldval
)
1417 Lisp_Object arg
, oldval
;
1423 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1425 unload_color (f
, f
->output_data
.x
->background_pixel
);
1426 f
->output_data
.x
->background_pixel
= pixel
;
1428 if (FRAME_X_WINDOW (f
) != 0)
1431 /* The main frame area. */
1432 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1433 f
->output_data
.x
->background_pixel
);
1434 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1435 f
->output_data
.x
->background_pixel
);
1436 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1437 f
->output_data
.x
->background_pixel
);
1438 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1439 f
->output_data
.x
->background_pixel
);
1442 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1443 bar
= XSCROLL_BAR (bar
)->next
)
1444 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1445 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1446 f
->output_data
.x
->background_pixel
);
1450 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1452 if (FRAME_VISIBLE_P (f
))
1458 x_set_mouse_color (f
, arg
, oldval
)
1460 Lisp_Object arg
, oldval
;
1462 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1465 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1466 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1468 /* Don't let pointers be invisible. */
1469 if (mask_color
== pixel
1470 && mask_color
== f
->output_data
.x
->background_pixel
)
1471 pixel
= f
->output_data
.x
->foreground_pixel
;
1473 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1474 f
->output_data
.x
->mouse_pixel
= pixel
;
1478 /* It's not okay to crash if the user selects a screwy cursor. */
1479 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1481 if (!EQ (Qnil
, Vx_pointer_shape
))
1483 CHECK_NUMBER (Vx_pointer_shape
, 0);
1484 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1487 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1488 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1490 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1492 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1493 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1494 XINT (Vx_nontext_pointer_shape
));
1497 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1498 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1500 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1502 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1503 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1504 XINT (Vx_busy_pointer_shape
));
1507 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1508 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1510 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1511 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1513 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1514 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1515 XINT (Vx_mode_pointer_shape
));
1518 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1519 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1521 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1523 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1525 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1526 XINT (Vx_sensitive_text_pointer_shape
));
1529 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1531 /* Check and report errors with the above calls. */
1532 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1533 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1536 XColor fore_color
, back_color
;
1538 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1539 back_color
.pixel
= mask_color
;
1540 XQueryColor (FRAME_X_DISPLAY (f
),
1541 DefaultColormap (FRAME_X_DISPLAY (f
),
1542 DefaultScreen (FRAME_X_DISPLAY (f
))),
1544 XQueryColor (FRAME_X_DISPLAY (f
),
1545 DefaultColormap (FRAME_X_DISPLAY (f
),
1546 DefaultScreen (FRAME_X_DISPLAY (f
))),
1548 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1549 &fore_color
, &back_color
);
1550 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1551 &fore_color
, &back_color
);
1552 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1553 &fore_color
, &back_color
);
1554 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1555 &fore_color
, &back_color
);
1556 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1557 &fore_color
, &back_color
);
1560 if (FRAME_X_WINDOW (f
) != 0)
1561 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1563 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1564 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1565 f
->output_data
.x
->text_cursor
= cursor
;
1567 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1568 && f
->output_data
.x
->nontext_cursor
!= 0)
1569 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1570 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1572 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1573 && f
->output_data
.x
->busy_cursor
!= 0)
1574 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1575 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1577 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1578 && f
->output_data
.x
->modeline_cursor
!= 0)
1579 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1580 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1582 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1583 && f
->output_data
.x
->cross_cursor
!= 0)
1584 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1585 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1587 XFlush (FRAME_X_DISPLAY (f
));
1590 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1594 x_set_cursor_color (f
, arg
, oldval
)
1596 Lisp_Object arg
, oldval
;
1598 unsigned long fore_pixel
, pixel
;
1600 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1601 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1602 WHITE_PIX_DEFAULT (f
));
1604 fore_pixel
= f
->output_data
.x
->background_pixel
;
1605 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1607 /* Make sure that the cursor color differs from the background color. */
1608 if (pixel
== f
->output_data
.x
->background_pixel
)
1610 pixel
= f
->output_data
.x
->mouse_pixel
;
1611 if (pixel
== fore_pixel
)
1612 fore_pixel
= f
->output_data
.x
->background_pixel
;
1615 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1616 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1618 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1619 f
->output_data
.x
->cursor_pixel
= pixel
;
1621 if (FRAME_X_WINDOW (f
) != 0)
1624 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1625 f
->output_data
.x
->cursor_pixel
);
1626 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1630 if (FRAME_VISIBLE_P (f
))
1632 x_update_cursor (f
, 0);
1633 x_update_cursor (f
, 1);
1637 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1640 /* Set the border-color of frame F to value described by ARG.
1641 ARG can be a string naming a color.
1642 The border-color is used for the border that is drawn by the X server.
1643 Note that this does not fully take effect if done before
1644 F has an x-window; it must be redone when the window is created.
1646 Note: this is done in two routines because of the way X10 works.
1648 Note: under X11, this is normally the province of the window manager,
1649 and so emacs' border colors may be overridden. */
1652 x_set_border_color (f
, arg
, oldval
)
1654 Lisp_Object arg
, oldval
;
1658 CHECK_STRING (arg
, 0);
1659 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1660 x_set_border_pixel (f
, pix
);
1661 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1664 /* Set the border-color of frame F to pixel value PIX.
1665 Note that this does not fully take effect if done before
1666 F has an x-window. */
1669 x_set_border_pixel (f
, pix
)
1673 unload_color (f
, f
->output_data
.x
->border_pixel
);
1674 f
->output_data
.x
->border_pixel
= pix
;
1676 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1682 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1683 (unsigned long)pix
);
1686 if (FRAME_VISIBLE_P (f
))
1692 x_set_cursor_type (f
, arg
, oldval
)
1694 Lisp_Object arg
, oldval
;
1698 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1699 f
->output_data
.x
->cursor_width
= 2;
1701 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1702 && INTEGERP (XCONS (arg
)->cdr
))
1704 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1705 f
->output_data
.x
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1708 /* Treat anything unknown as "box cursor".
1709 It was bad to signal an error; people have trouble fixing
1710 .Xdefaults with Emacs, when it has something bad in it. */
1711 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1713 /* Make sure the cursor gets redrawn. This is overkill, but how
1714 often do people change cursor types? */
1715 update_mode_lines
++;
1719 x_set_icon_type (f
, arg
, oldval
)
1721 Lisp_Object arg
, oldval
;
1727 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1730 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1735 result
= x_text_icon (f
,
1736 (char *) XSTRING ((!NILP (f
->icon_name
)
1740 result
= x_bitmap_icon (f
, arg
);
1745 error ("No icon window available");
1748 XFlush (FRAME_X_DISPLAY (f
));
1752 /* Return non-nil if frame F wants a bitmap icon. */
1760 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1762 return XCONS (tem
)->cdr
;
1768 x_set_icon_name (f
, arg
, oldval
)
1770 Lisp_Object arg
, oldval
;
1776 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1779 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1784 if (f
->output_data
.x
->icon_bitmap
!= 0)
1789 result
= x_text_icon (f
,
1790 (char *) XSTRING ((!NILP (f
->icon_name
)
1799 error ("No icon window available");
1802 XFlush (FRAME_X_DISPLAY (f
));
1807 x_set_font (f
, arg
, oldval
)
1809 Lisp_Object arg
, oldval
;
1812 Lisp_Object fontset_name
;
1815 CHECK_STRING (arg
, 1);
1817 fontset_name
= Fquery_fontset (arg
, Qnil
);
1820 result
= (STRINGP (fontset_name
)
1821 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1822 : x_new_font (f
, XSTRING (arg
)->data
));
1825 if (EQ (result
, Qnil
))
1826 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1827 else if (EQ (result
, Qt
))
1828 error ("The characters of the given font have varying widths");
1829 else if (STRINGP (result
))
1831 store_frame_param (f
, Qfont
, result
);
1832 recompute_basic_faces (f
);
1837 do_pending_window_change (0);
1839 /* Don't call `face-set-after-frame-default' when faces haven't been
1840 initialized yet. This is the case when called from
1841 Fx_create_frame. In that case, the X widget or window doesn't
1842 exist either, and we can end up in x_report_frame_params with a
1843 null widget which gives a segfault. */
1844 if (FRAME_FACE_CACHE (f
))
1846 XSETFRAME (frame
, f
);
1847 call1 (Qface_set_after_frame_default
, frame
);
1852 x_set_border_width (f
, arg
, oldval
)
1854 Lisp_Object arg
, oldval
;
1856 CHECK_NUMBER (arg
, 0);
1858 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1861 if (FRAME_X_WINDOW (f
) != 0)
1862 error ("Cannot change the border width of a window");
1864 f
->output_data
.x
->border_width
= XINT (arg
);
1868 x_set_internal_border_width (f
, arg
, oldval
)
1870 Lisp_Object arg
, oldval
;
1872 int old
= f
->output_data
.x
->internal_border_width
;
1874 CHECK_NUMBER (arg
, 0);
1875 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1876 if (f
->output_data
.x
->internal_border_width
< 0)
1877 f
->output_data
.x
->internal_border_width
= 0;
1879 #ifdef USE_X_TOOLKIT
1880 if (f
->output_data
.x
->edit_widget
)
1881 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1884 if (f
->output_data
.x
->internal_border_width
== old
)
1887 if (FRAME_X_WINDOW (f
) != 0)
1889 x_set_window_size (f
, 0, f
->width
, f
->height
);
1890 SET_FRAME_GARBAGED (f
);
1891 do_pending_window_change (0);
1896 x_set_visibility (f
, value
, oldval
)
1898 Lisp_Object value
, oldval
;
1901 XSETFRAME (frame
, f
);
1904 Fmake_frame_invisible (frame
, Qt
);
1905 else if (EQ (value
, Qicon
))
1906 Ficonify_frame (frame
);
1908 Fmake_frame_visible (frame
);
1912 x_set_menu_bar_lines_1 (window
, n
)
1916 struct window
*w
= XWINDOW (window
);
1918 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1919 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1921 /* Handle just the top child in a vertical split. */
1922 if (!NILP (w
->vchild
))
1923 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1925 /* Adjust all children in a horizontal split. */
1926 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1928 w
= XWINDOW (window
);
1929 x_set_menu_bar_lines_1 (window
, n
);
1934 x_set_menu_bar_lines (f
, value
, oldval
)
1936 Lisp_Object value
, oldval
;
1939 int olines
= FRAME_MENU_BAR_LINES (f
);
1941 /* Right now, menu bars don't work properly in minibuf-only frames;
1942 most of the commands try to apply themselves to the minibuffer
1943 frame itself, and get an error because you can't switch buffers
1944 in or split the minibuffer window. */
1945 if (FRAME_MINIBUF_ONLY_P (f
))
1948 if (INTEGERP (value
))
1949 nlines
= XINT (value
);
1953 /* Make sure we redisplay all windows in this frame. */
1954 windows_or_buffers_changed
++;
1956 #ifdef USE_X_TOOLKIT
1957 FRAME_MENU_BAR_LINES (f
) = 0;
1960 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1961 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1962 /* Make sure next redisplay shows the menu bar. */
1963 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1967 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1968 free_frame_menubar (f
);
1969 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1971 f
->output_data
.x
->menubar_widget
= 0;
1973 #else /* not USE_X_TOOLKIT */
1974 FRAME_MENU_BAR_LINES (f
) = nlines
;
1975 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1976 #endif /* not USE_X_TOOLKIT */
1981 /* Set the number of lines used for the tool bar of frame F to VALUE.
1982 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1983 is the old number of tool bar lines. This function changes the
1984 height of all windows on frame F to match the new tool bar height.
1985 The frame's height doesn't change. */
1988 x_set_tool_bar_lines (f
, value
, oldval
)
1990 Lisp_Object value
, oldval
;
1994 /* Use VALUE only if an integer >= 0. */
1995 if (INTEGERP (value
) && XINT (value
) >= 0)
1996 nlines
= XFASTINT (value
);
2000 /* Make sure we redisplay all windows in this frame. */
2001 ++windows_or_buffers_changed
;
2003 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
2004 FRAME_TOOL_BAR_LINES (f
) = nlines
;
2005 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2010 /* Set the foreground color for scroll bars on frame F to VALUE.
2011 VALUE should be a string, a color name. If it isn't a string or
2012 isn't a valid color name, do nothing. OLDVAL is the old value of
2013 the frame parameter. */
2016 x_set_scroll_bar_foreground (f
, value
, oldval
)
2018 Lisp_Object value
, oldval
;
2020 unsigned long pixel
;
2022 if (STRINGP (value
))
2023 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2027 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2028 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2030 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2031 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2033 /* Remove all scroll bars because they have wrong colors. */
2034 if (condemn_scroll_bars_hook
)
2035 (*condemn_scroll_bars_hook
) (f
);
2036 if (judge_scroll_bars_hook
)
2037 (*judge_scroll_bars_hook
) (f
);
2039 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2045 /* Set the background color for scroll bars on frame F to VALUE VALUE
2046 should be a string, a color name. If it isn't a string or isn't a
2047 valid color name, do nothing. OLDVAL is the old value of the frame
2051 x_set_scroll_bar_background (f
, value
, oldval
)
2053 Lisp_Object value
, oldval
;
2055 unsigned long pixel
;
2057 if (STRINGP (value
))
2058 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2062 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2063 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2065 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2066 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2068 /* Remove all scroll bars because they have wrong colors. */
2069 if (condemn_scroll_bars_hook
)
2070 (*condemn_scroll_bars_hook
) (f
);
2071 if (judge_scroll_bars_hook
)
2072 (*judge_scroll_bars_hook
) (f
);
2074 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2080 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2083 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2084 name; if NAME is a string, set F's name to NAME and set
2085 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2087 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2088 suggesting a new name, which lisp code should override; if
2089 F->explicit_name is set, ignore the new name; otherwise, set it. */
2092 x_set_name (f
, name
, explicit)
2097 /* Make sure that requests from lisp code override requests from
2098 Emacs redisplay code. */
2101 /* If we're switching from explicit to implicit, we had better
2102 update the mode lines and thereby update the title. */
2103 if (f
->explicit_name
&& NILP (name
))
2104 update_mode_lines
= 1;
2106 f
->explicit_name
= ! NILP (name
);
2108 else if (f
->explicit_name
)
2111 /* If NAME is nil, set the name to the x_id_name. */
2114 /* Check for no change needed in this very common case
2115 before we do any consing. */
2116 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2117 XSTRING (f
->name
)->data
))
2119 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2122 CHECK_STRING (name
, 0);
2124 /* Don't change the name if it's already NAME. */
2125 if (! NILP (Fstring_equal (name
, f
->name
)))
2130 /* For setting the frame title, the title parameter should override
2131 the name parameter. */
2132 if (! NILP (f
->title
))
2135 if (FRAME_X_WINDOW (f
))
2140 XTextProperty text
, icon
;
2141 Lisp_Object icon_name
;
2143 text
.value
= XSTRING (name
)->data
;
2144 text
.encoding
= XA_STRING
;
2146 text
.nitems
= STRING_BYTES (XSTRING (name
));
2148 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2150 icon
.value
= XSTRING (icon_name
)->data
;
2151 icon
.encoding
= XA_STRING
;
2153 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2154 #ifdef USE_X_TOOLKIT
2155 XSetWMName (FRAME_X_DISPLAY (f
),
2156 XtWindow (f
->output_data
.x
->widget
), &text
);
2157 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2159 #else /* not USE_X_TOOLKIT */
2160 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2161 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2162 #endif /* not USE_X_TOOLKIT */
2164 #else /* not HAVE_X11R4 */
2165 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2166 XSTRING (name
)->data
);
2167 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2168 XSTRING (name
)->data
);
2169 #endif /* not HAVE_X11R4 */
2174 /* This function should be called when the user's lisp code has
2175 specified a name for the frame; the name will override any set by the
2178 x_explicitly_set_name (f
, arg
, oldval
)
2180 Lisp_Object arg
, oldval
;
2182 x_set_name (f
, arg
, 1);
2185 /* This function should be called by Emacs redisplay code to set the
2186 name; names set this way will never override names set by the user's
2189 x_implicitly_set_name (f
, arg
, oldval
)
2191 Lisp_Object arg
, oldval
;
2193 x_set_name (f
, arg
, 0);
2196 /* Change the title of frame F to NAME.
2197 If NAME is nil, use the frame name as the title.
2199 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2200 name; if NAME is a string, set F's name to NAME and set
2201 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2203 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2204 suggesting a new name, which lisp code should override; if
2205 F->explicit_name is set, ignore the new name; otherwise, set it. */
2208 x_set_title (f
, name
, old_name
)
2210 Lisp_Object name
, old_name
;
2212 /* Don't change the title if it's already NAME. */
2213 if (EQ (name
, f
->title
))
2216 update_mode_lines
= 1;
2223 CHECK_STRING (name
, 0);
2225 if (FRAME_X_WINDOW (f
))
2230 XTextProperty text
, icon
;
2231 Lisp_Object icon_name
;
2233 text
.value
= XSTRING (name
)->data
;
2234 text
.encoding
= XA_STRING
;
2236 text
.nitems
= STRING_BYTES (XSTRING (name
));
2238 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2240 icon
.value
= XSTRING (icon_name
)->data
;
2241 icon
.encoding
= XA_STRING
;
2243 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2244 #ifdef USE_X_TOOLKIT
2245 XSetWMName (FRAME_X_DISPLAY (f
),
2246 XtWindow (f
->output_data
.x
->widget
), &text
);
2247 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2249 #else /* not USE_X_TOOLKIT */
2250 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2251 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2252 #endif /* not USE_X_TOOLKIT */
2254 #else /* not HAVE_X11R4 */
2255 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2256 XSTRING (name
)->data
);
2257 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2258 XSTRING (name
)->data
);
2259 #endif /* not HAVE_X11R4 */
2265 x_set_autoraise (f
, arg
, oldval
)
2267 Lisp_Object arg
, oldval
;
2269 f
->auto_raise
= !EQ (Qnil
, arg
);
2273 x_set_autolower (f
, arg
, oldval
)
2275 Lisp_Object arg
, oldval
;
2277 f
->auto_lower
= !EQ (Qnil
, arg
);
2281 x_set_unsplittable (f
, arg
, oldval
)
2283 Lisp_Object arg
, oldval
;
2285 f
->no_split
= !NILP (arg
);
2289 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2291 Lisp_Object arg
, oldval
;
2293 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2294 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2295 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2296 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2298 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2300 ? vertical_scroll_bar_none
2302 ? vertical_scroll_bar_right
2303 : vertical_scroll_bar_left
);
2305 /* We set this parameter before creating the X window for the
2306 frame, so we can get the geometry right from the start.
2307 However, if the window hasn't been created yet, we shouldn't
2308 call x_set_window_size. */
2309 if (FRAME_X_WINDOW (f
))
2310 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2311 do_pending_window_change (0);
2316 x_set_scroll_bar_width (f
, arg
, oldval
)
2318 Lisp_Object arg
, oldval
;
2320 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2324 #ifdef USE_TOOLKIT_SCROLL_BARS
2325 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2326 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2327 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2328 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2330 /* Make the actual width at least 14 pixels and a multiple of a
2332 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2334 /* Use all of that space (aside from required margins) for the
2336 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2339 if (FRAME_X_WINDOW (f
))
2340 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2341 do_pending_window_change (0);
2343 else if (INTEGERP (arg
) && XINT (arg
) > 0
2344 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2346 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2347 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2349 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2350 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2351 if (FRAME_X_WINDOW (f
))
2352 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2355 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2356 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2357 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2362 /* Subroutines of creating an X frame. */
2364 /* Make sure that Vx_resource_name is set to a reasonable value.
2365 Fix it up, or set it to `emacs' if it is too hopeless. */
2368 validate_x_resource_name ()
2371 /* Number of valid characters in the resource name. */
2373 /* Number of invalid characters in the resource name. */
2378 if (!STRINGP (Vx_resource_class
))
2379 Vx_resource_class
= build_string (EMACS_CLASS
);
2381 if (STRINGP (Vx_resource_name
))
2383 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2386 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2388 /* Only letters, digits, - and _ are valid in resource names.
2389 Count the valid characters and count the invalid ones. */
2390 for (i
= 0; i
< len
; i
++)
2393 if (! ((c
>= 'a' && c
<= 'z')
2394 || (c
>= 'A' && c
<= 'Z')
2395 || (c
>= '0' && c
<= '9')
2396 || c
== '-' || c
== '_'))
2403 /* Not a string => completely invalid. */
2404 bad_count
= 5, good_count
= 0;
2406 /* If name is valid already, return. */
2410 /* If name is entirely invalid, or nearly so, use `emacs'. */
2412 || (good_count
== 1 && bad_count
> 0))
2414 Vx_resource_name
= build_string ("emacs");
2418 /* Name is partly valid. Copy it and replace the invalid characters
2419 with underscores. */
2421 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2423 for (i
= 0; i
< len
; i
++)
2425 int c
= XSTRING (new)->data
[i
];
2426 if (! ((c
>= 'a' && c
<= 'z')
2427 || (c
>= 'A' && c
<= 'Z')
2428 || (c
>= '0' && c
<= '9')
2429 || c
== '-' || c
== '_'))
2430 XSTRING (new)->data
[i
] = '_';
2435 extern char *x_get_string_resource ();
2437 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2438 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2439 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2440 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2441 the name specified by the `-name' or `-rn' command-line arguments.\n\
2443 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2444 class, respectively. You must specify both of them or neither.\n\
2445 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2446 and the class is `Emacs.CLASS.SUBCLASS'.")
2447 (attribute
, class, component
, subclass
)
2448 Lisp_Object attribute
, class, component
, subclass
;
2450 register char *value
;
2456 CHECK_STRING (attribute
, 0);
2457 CHECK_STRING (class, 0);
2459 if (!NILP (component
))
2460 CHECK_STRING (component
, 1);
2461 if (!NILP (subclass
))
2462 CHECK_STRING (subclass
, 2);
2463 if (NILP (component
) != NILP (subclass
))
2464 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2466 validate_x_resource_name ();
2468 /* Allocate space for the components, the dots which separate them,
2469 and the final '\0'. Make them big enough for the worst case. */
2470 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2471 + (STRINGP (component
)
2472 ? STRING_BYTES (XSTRING (component
)) : 0)
2473 + STRING_BYTES (XSTRING (attribute
))
2476 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2477 + STRING_BYTES (XSTRING (class))
2478 + (STRINGP (subclass
)
2479 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2482 /* Start with emacs.FRAMENAME for the name (the specific one)
2483 and with `Emacs' for the class key (the general one). */
2484 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2485 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2487 strcat (class_key
, ".");
2488 strcat (class_key
, XSTRING (class)->data
);
2490 if (!NILP (component
))
2492 strcat (class_key
, ".");
2493 strcat (class_key
, XSTRING (subclass
)->data
);
2495 strcat (name_key
, ".");
2496 strcat (name_key
, XSTRING (component
)->data
);
2499 strcat (name_key
, ".");
2500 strcat (name_key
, XSTRING (attribute
)->data
);
2502 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2503 name_key
, class_key
);
2505 if (value
!= (char *) 0)
2506 return build_string (value
);
2511 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2514 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2515 struct x_display_info
*dpyinfo
;
2516 Lisp_Object attribute
, class, component
, subclass
;
2518 register char *value
;
2524 CHECK_STRING (attribute
, 0);
2525 CHECK_STRING (class, 0);
2527 if (!NILP (component
))
2528 CHECK_STRING (component
, 1);
2529 if (!NILP (subclass
))
2530 CHECK_STRING (subclass
, 2);
2531 if (NILP (component
) != NILP (subclass
))
2532 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2534 validate_x_resource_name ();
2536 /* Allocate space for the components, the dots which separate them,
2537 and the final '\0'. Make them big enough for the worst case. */
2538 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2539 + (STRINGP (component
)
2540 ? STRING_BYTES (XSTRING (component
)) : 0)
2541 + STRING_BYTES (XSTRING (attribute
))
2544 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2545 + STRING_BYTES (XSTRING (class))
2546 + (STRINGP (subclass
)
2547 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2550 /* Start with emacs.FRAMENAME for the name (the specific one)
2551 and with `Emacs' for the class key (the general one). */
2552 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2553 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2555 strcat (class_key
, ".");
2556 strcat (class_key
, XSTRING (class)->data
);
2558 if (!NILP (component
))
2560 strcat (class_key
, ".");
2561 strcat (class_key
, XSTRING (subclass
)->data
);
2563 strcat (name_key
, ".");
2564 strcat (name_key
, XSTRING (component
)->data
);
2567 strcat (name_key
, ".");
2568 strcat (name_key
, XSTRING (attribute
)->data
);
2570 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2572 if (value
!= (char *) 0)
2573 return build_string (value
);
2578 /* Used when C code wants a resource value. */
2581 x_get_resource_string (attribute
, class)
2582 char *attribute
, *class;
2587 /* Allocate space for the components, the dots which separate them,
2588 and the final '\0'. */
2589 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2590 + strlen (attribute
) + 2);
2591 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2592 + strlen (class) + 2);
2594 sprintf (name_key
, "%s.%s",
2595 XSTRING (Vinvocation_name
)->data
,
2597 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2599 return x_get_string_resource (FRAME_X_DISPLAY_INFO (selected_frame
)->xrdb
,
2600 name_key
, class_key
);
2603 /* Types we might convert a resource string into. */
2613 /* Return the value of parameter PARAM.
2615 First search ALIST, then Vdefault_frame_alist, then the X defaults
2616 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2618 Convert the resource to the type specified by desired_type.
2620 If no default is specified, return Qunbound. If you call
2621 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2622 and don't let it get stored in any Lisp-visible variables! */
2625 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2626 struct x_display_info
*dpyinfo
;
2627 Lisp_Object alist
, param
;
2630 enum resource_types type
;
2632 register Lisp_Object tem
;
2634 tem
= Fassq (param
, alist
);
2636 tem
= Fassq (param
, Vdefault_frame_alist
);
2642 tem
= display_x_get_resource (dpyinfo
,
2643 build_string (attribute
),
2644 build_string (class),
2652 case RES_TYPE_NUMBER
:
2653 return make_number (atoi (XSTRING (tem
)->data
));
2655 case RES_TYPE_FLOAT
:
2656 return make_float (atof (XSTRING (tem
)->data
));
2658 case RES_TYPE_BOOLEAN
:
2659 tem
= Fdowncase (tem
);
2660 if (!strcmp (XSTRING (tem
)->data
, "on")
2661 || !strcmp (XSTRING (tem
)->data
, "true"))
2666 case RES_TYPE_STRING
:
2669 case RES_TYPE_SYMBOL
:
2670 /* As a special case, we map the values `true' and `on'
2671 to Qt, and `false' and `off' to Qnil. */
2674 lower
= Fdowncase (tem
);
2675 if (!strcmp (XSTRING (lower
)->data
, "on")
2676 || !strcmp (XSTRING (lower
)->data
, "true"))
2678 else if (!strcmp (XSTRING (lower
)->data
, "off")
2679 || !strcmp (XSTRING (lower
)->data
, "false"))
2682 return Fintern (tem
, Qnil
);
2695 /* Like x_get_arg, but also record the value in f->param_alist. */
2698 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2700 Lisp_Object alist
, param
;
2703 enum resource_types type
;
2707 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2708 attribute
, class, type
);
2710 store_frame_param (f
, param
, value
);
2715 /* Record in frame F the specified or default value according to ALIST
2716 of the parameter named PROP (a Lisp symbol).
2717 If no value is specified for PROP, look for an X default for XPROP
2718 on the frame named NAME.
2719 If that is not found either, use the value DEFLT. */
2722 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2729 enum resource_types type
;
2733 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2734 if (EQ (tem
, Qunbound
))
2736 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2741 /* Record in frame F the specified or default value according to ALIST
2742 of the parameter named PROP (a Lisp symbol). If no value is
2743 specified for PROP, look for an X default for XPROP on the frame
2744 named NAME. If that is not found either, use the value DEFLT. */
2747 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2756 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2759 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2760 if (EQ (tem
, Qunbound
))
2762 #ifdef USE_TOOLKIT_SCROLL_BARS
2764 /* See if an X resource for the scroll bar color has been
2766 tem
= display_x_get_resource (dpyinfo
,
2767 build_string (foreground_p
2771 build_string ("verticalScrollBar"),
2775 /* If nothing has been specified, scroll bars will use a
2776 toolkit-dependent default. Because these defaults are
2777 difficult to get at without actually creating a scroll
2778 bar, use nil to indicate that no color has been
2783 #else /* not USE_TOOLKIT_SCROLL_BARS */
2787 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2790 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2796 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2797 "Parse an X-style geometry string STRING.\n\
2798 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2799 The properties returned may include `top', `left', `height', and `width'.\n\
2800 The value of `left' or `top' may be an integer,\n\
2801 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2802 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2807 unsigned int width
, height
;
2810 CHECK_STRING (string
, 0);
2812 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2813 &x
, &y
, &width
, &height
);
2816 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2817 error ("Must specify both x and y position, or neither");
2821 if (geometry
& XValue
)
2823 Lisp_Object element
;
2825 if (x
>= 0 && (geometry
& XNegative
))
2826 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2827 else if (x
< 0 && ! (geometry
& XNegative
))
2828 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2830 element
= Fcons (Qleft
, make_number (x
));
2831 result
= Fcons (element
, result
);
2834 if (geometry
& YValue
)
2836 Lisp_Object element
;
2838 if (y
>= 0 && (geometry
& YNegative
))
2839 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2840 else if (y
< 0 && ! (geometry
& YNegative
))
2841 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2843 element
= Fcons (Qtop
, make_number (y
));
2844 result
= Fcons (element
, result
);
2847 if (geometry
& WidthValue
)
2848 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2849 if (geometry
& HeightValue
)
2850 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2855 /* Calculate the desired size and position of this window,
2856 and return the flags saying which aspects were specified.
2858 This function does not make the coordinates positive. */
2860 #define DEFAULT_ROWS 40
2861 #define DEFAULT_COLS 80
2864 x_figure_window_size (f
, parms
)
2868 register Lisp_Object tem0
, tem1
, tem2
;
2869 int height
, width
, left
, top
;
2870 register int geometry
;
2871 long window_prompting
= 0;
2872 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2874 /* Default values if we fall through.
2875 Actually, if that happens we should get
2876 window manager prompting. */
2877 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2878 f
->height
= DEFAULT_ROWS
;
2879 /* Window managers expect that if program-specified
2880 positions are not (0,0), they're intentional, not defaults. */
2881 f
->output_data
.x
->top_pos
= 0;
2882 f
->output_data
.x
->left_pos
= 0;
2884 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2885 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2886 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2887 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2889 if (!EQ (tem0
, Qunbound
))
2891 CHECK_NUMBER (tem0
, 0);
2892 f
->height
= XINT (tem0
);
2894 if (!EQ (tem1
, Qunbound
))
2896 CHECK_NUMBER (tem1
, 0);
2897 SET_FRAME_WIDTH (f
, XINT (tem1
));
2899 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2900 window_prompting
|= USSize
;
2902 window_prompting
|= PSize
;
2905 f
->output_data
.x
->vertical_scroll_bar_extra
2906 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2908 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2909 f
->output_data
.x
->flags_areas_extra
2910 = FRAME_FLAGS_AREA_WIDTH (f
);
2911 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2912 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2914 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2915 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2916 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2917 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2919 if (EQ (tem0
, Qminus
))
2921 f
->output_data
.x
->top_pos
= 0;
2922 window_prompting
|= YNegative
;
2924 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2925 && CONSP (XCONS (tem0
)->cdr
)
2926 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2928 f
->output_data
.x
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2929 window_prompting
|= YNegative
;
2931 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2932 && CONSP (XCONS (tem0
)->cdr
)
2933 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2935 f
->output_data
.x
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2937 else if (EQ (tem0
, Qunbound
))
2938 f
->output_data
.x
->top_pos
= 0;
2941 CHECK_NUMBER (tem0
, 0);
2942 f
->output_data
.x
->top_pos
= XINT (tem0
);
2943 if (f
->output_data
.x
->top_pos
< 0)
2944 window_prompting
|= YNegative
;
2947 if (EQ (tem1
, Qminus
))
2949 f
->output_data
.x
->left_pos
= 0;
2950 window_prompting
|= XNegative
;
2952 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2953 && CONSP (XCONS (tem1
)->cdr
)
2954 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2956 f
->output_data
.x
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2957 window_prompting
|= XNegative
;
2959 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2960 && CONSP (XCONS (tem1
)->cdr
)
2961 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2963 f
->output_data
.x
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2965 else if (EQ (tem1
, Qunbound
))
2966 f
->output_data
.x
->left_pos
= 0;
2969 CHECK_NUMBER (tem1
, 0);
2970 f
->output_data
.x
->left_pos
= XINT (tem1
);
2971 if (f
->output_data
.x
->left_pos
< 0)
2972 window_prompting
|= XNegative
;
2975 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2976 window_prompting
|= USPosition
;
2978 window_prompting
|= PPosition
;
2981 return window_prompting
;
2984 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2987 XSetWMProtocols (dpy
, w
, protocols
, count
)
2994 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2995 if (prop
== None
) return False
;
2996 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2997 (unsigned char *) protocols
, count
);
3000 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3002 #ifdef USE_X_TOOLKIT
3004 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3005 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3006 already be present because of the toolkit (Motif adds some of them,
3007 for example, but Xt doesn't). */
3010 hack_wm_protocols (f
, widget
)
3014 Display
*dpy
= XtDisplay (widget
);
3015 Window w
= XtWindow (widget
);
3016 int need_delete
= 1;
3022 Atom type
, *atoms
= 0;
3024 unsigned long nitems
= 0;
3025 unsigned long bytes_after
;
3027 if ((XGetWindowProperty (dpy
, w
,
3028 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3029 (long)0, (long)100, False
, XA_ATOM
,
3030 &type
, &format
, &nitems
, &bytes_after
,
3031 (unsigned char **) &atoms
)
3033 && format
== 32 && type
== XA_ATOM
)
3037 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3039 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3041 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3044 if (atoms
) XFree ((char *) atoms
);
3050 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3052 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3054 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3056 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3057 XA_ATOM
, 32, PropModeAppend
,
3058 (unsigned char *) props
, count
);
3064 #ifdef USE_X_TOOLKIT
3066 /* Create and set up the X widget for frame F. */
3069 x_window (f
, window_prompting
, minibuffer_only
)
3071 long window_prompting
;
3072 int minibuffer_only
;
3074 XClassHint class_hints
;
3075 XSetWindowAttributes attributes
;
3076 unsigned long attribute_mask
;
3078 Widget shell_widget
;
3080 Widget frame_widget
;
3086 /* Use the resource name as the top-level widget name
3087 for looking up resources. Make a non-Lisp copy
3088 for the window manager, so GC relocation won't bother it.
3090 Elsewhere we specify the window name for the window manager. */
3093 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3094 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3095 strcpy (f
->namebuf
, str
);
3099 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3100 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3101 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3102 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3103 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3104 applicationShellWidgetClass
,
3105 FRAME_X_DISPLAY (f
), al
, ac
);
3107 f
->output_data
.x
->widget
= shell_widget
;
3108 /* maybe_set_screen_title_format (shell_widget); */
3110 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3111 (widget_value
*) NULL
,
3112 shell_widget
, False
,
3115 (lw_callback
) NULL
);
3117 f
->output_data
.x
->column_widget
= pane_widget
;
3119 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3120 the emacs screen when changing menubar. This reduces flickering. */
3123 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3124 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3125 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3126 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3127 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3128 frame_widget
= XtCreateWidget (f
->namebuf
,
3130 pane_widget
, al
, ac
);
3132 f
->output_data
.x
->edit_widget
= frame_widget
;
3134 XtManageChild (frame_widget
);
3136 /* Do some needed geometry management. */
3139 char *tem
, shell_position
[32];
3142 int extra_borders
= 0;
3144 = (f
->output_data
.x
->menubar_widget
3145 ? (f
->output_data
.x
->menubar_widget
->core
.height
3146 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3148 extern char *lwlib_toolkit_type
;
3150 #if 0 /* Experimentally, we now get the right results
3151 for -geometry -0-0 without this. 24 Aug 96, rms. */
3152 if (FRAME_EXTERNAL_MENU_BAR (f
))
3155 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3156 menubar_size
+= ibw
;
3160 f
->output_data
.x
->menubar_height
= menubar_size
;
3163 /* Motif seems to need this amount added to the sizes
3164 specified for the shell widget. The Athena/Lucid widgets don't.
3165 Both conclusions reached experimentally. -- rms. */
3166 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3167 &extra_borders
, NULL
);
3171 /* Convert our geometry parameters into a geometry string
3173 Note that we do not specify here whether the position
3174 is a user-specified or program-specified one.
3175 We pass that information later, in x_wm_set_size_hints. */
3177 int left
= f
->output_data
.x
->left_pos
;
3178 int xneg
= window_prompting
& XNegative
;
3179 int top
= f
->output_data
.x
->top_pos
;
3180 int yneg
= window_prompting
& YNegative
;
3186 if (window_prompting
& USPosition
)
3187 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3188 PIXEL_WIDTH (f
) + extra_borders
,
3189 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3190 (xneg
? '-' : '+'), left
,
3191 (yneg
? '-' : '+'), top
);
3193 sprintf (shell_position
, "=%dx%d",
3194 PIXEL_WIDTH (f
) + extra_borders
,
3195 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3198 len
= strlen (shell_position
) + 1;
3199 /* We don't free this because we don't know whether
3200 it is safe to free it while the frame exists.
3201 It isn't worth the trouble of arranging to free it
3202 when the frame is deleted. */
3203 tem
= (char *) xmalloc (len
);
3204 strncpy (tem
, shell_position
, len
);
3205 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3206 XtSetValues (shell_widget
, al
, ac
);
3209 XtManageChild (pane_widget
);
3210 XtRealizeWidget (shell_widget
);
3212 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3214 validate_x_resource_name ();
3216 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3217 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3218 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3221 #ifndef X_I18N_INHIBITED
3226 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
3230 xic
= XCreateIC (xim
,
3231 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3232 XNClientWindow
, FRAME_X_WINDOW(f
),
3233 XNFocusWindow
, FRAME_X_WINDOW(f
),
3242 FRAME_XIM (f
) = xim
;
3243 FRAME_XIC (f
) = xic
;
3245 #else /* X_I18N_INHIBITED */
3248 #endif /* X_I18N_INHIBITED */
3249 #endif /* HAVE_X_I18N */
3251 f
->output_data
.x
->wm_hints
.input
= True
;
3252 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3253 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3254 &f
->output_data
.x
->wm_hints
);
3256 hack_wm_protocols (f
, shell_widget
);
3259 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3262 /* Do a stupid property change to force the server to generate a
3263 PropertyNotify event so that the event_stream server timestamp will
3264 be initialized to something relevant to the time we created the window.
3266 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3267 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3268 XA_ATOM
, 32, PropModeAppend
,
3269 (unsigned char*) NULL
, 0);
3271 /* Make all the standard events reach the Emacs frame. */
3272 attributes
.event_mask
= STANDARD_EVENT_SET
;
3273 attribute_mask
= CWEventMask
;
3274 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3275 attribute_mask
, &attributes
);
3277 XtMapWidget (frame_widget
);
3279 /* x_set_name normally ignores requests to set the name if the
3280 requested name is the same as the current name. This is the one
3281 place where that assumption isn't correct; f->name is set, but
3282 the X server hasn't been told. */
3285 int explicit = f
->explicit_name
;
3287 f
->explicit_name
= 0;
3290 x_set_name (f
, name
, explicit);
3293 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3294 f
->output_data
.x
->text_cursor
);
3298 /* This is a no-op, except under Motif. Make sure main areas are
3299 set to something reasonable, in case we get an error later. */
3300 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3303 #else /* not USE_X_TOOLKIT */
3305 /* Create and set up the X window for frame F. */
3312 XClassHint class_hints
;
3313 XSetWindowAttributes attributes
;
3314 unsigned long attribute_mask
;
3316 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3317 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3318 attributes
.bit_gravity
= StaticGravity
;
3319 attributes
.backing_store
= NotUseful
;
3320 attributes
.save_under
= True
;
3321 attributes
.event_mask
= STANDARD_EVENT_SET
;
3322 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3324 | CWBackingStore
| CWSaveUnder
3330 = XCreateWindow (FRAME_X_DISPLAY (f
),
3331 f
->output_data
.x
->parent_desc
,
3332 f
->output_data
.x
->left_pos
,
3333 f
->output_data
.x
->top_pos
,
3334 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3335 f
->output_data
.x
->border_width
,
3336 CopyFromParent
, /* depth */
3337 InputOutput
, /* class */
3338 FRAME_X_DISPLAY_INFO (f
)->visual
,
3339 attribute_mask
, &attributes
);
3341 #ifndef X_I18N_INHIBITED
3346 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3350 xic
= XCreateIC (xim
,
3351 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3352 XNClientWindow
, FRAME_X_WINDOW(f
),
3353 XNFocusWindow
, FRAME_X_WINDOW(f
),
3363 FRAME_XIM (f
) = xim
;
3364 FRAME_XIC (f
) = xic
;
3366 #else /* X_I18N_INHIBITED */
3369 #endif /* X_I18N_INHIBITED */
3370 #endif /* HAVE_X_I18N */
3372 validate_x_resource_name ();
3374 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3375 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3376 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3378 /* The menubar is part of the ordinary display;
3379 it does not count in addition to the height of the window. */
3380 f
->output_data
.x
->menubar_height
= 0;
3382 /* This indicates that we use the "Passive Input" input model.
3383 Unless we do this, we don't get the Focus{In,Out} events that we
3384 need to draw the cursor correctly. Accursed bureaucrats.
3385 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3387 f
->output_data
.x
->wm_hints
.input
= True
;
3388 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3389 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3390 &f
->output_data
.x
->wm_hints
);
3391 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3393 /* Request "save yourself" and "delete window" commands from wm. */
3396 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3397 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3398 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3401 /* x_set_name normally ignores requests to set the name if the
3402 requested name is the same as the current name. This is the one
3403 place where that assumption isn't correct; f->name is set, but
3404 the X server hasn't been told. */
3407 int explicit = f
->explicit_name
;
3409 f
->explicit_name
= 0;
3412 x_set_name (f
, name
, explicit);
3415 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3416 f
->output_data
.x
->text_cursor
);
3420 if (FRAME_X_WINDOW (f
) == 0)
3421 error ("Unable to create window");
3424 #endif /* not USE_X_TOOLKIT */
3426 /* Handle the icon stuff for this window. Perhaps later we might
3427 want an x_set_icon_position which can be called interactively as
3435 Lisp_Object icon_x
, icon_y
;
3436 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3438 /* Set the position of the icon. Note that twm groups all
3439 icons in an icon window. */
3440 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3441 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3442 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3444 CHECK_NUMBER (icon_x
, 0);
3445 CHECK_NUMBER (icon_y
, 0);
3447 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3448 error ("Both left and top icon corners of icon must be specified");
3452 if (! EQ (icon_x
, Qunbound
))
3453 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3455 /* Start up iconic or window? */
3456 x_wm_set_window_state
3457 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3462 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3469 /* Make the GC's needed for this window, setting the
3470 background, border and mouse colors; also create the
3471 mouse cursor and the gray border tile. */
3473 static char cursor_bits
[] =
3475 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3476 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3477 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3478 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3485 XGCValues gc_values
;
3489 /* Create the GC's of this frame.
3490 Note that many default values are used. */
3493 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3494 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3495 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3496 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3497 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3499 GCLineWidth
| GCFont
3500 | GCForeground
| GCBackground
,
3503 /* Reverse video style. */
3504 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3505 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3506 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3508 GCFont
| GCForeground
| GCBackground
3512 /* Cursor has cursor-color background, background-color foreground. */
3513 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3514 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3515 gc_values
.fill_style
= FillOpaqueStippled
;
3517 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3518 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3519 cursor_bits
, 16, 16);
3520 f
->output_data
.x
->cursor_gc
3521 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3522 (GCFont
| GCForeground
| GCBackground
3523 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3527 f
->output_data
.x
->white_relief
.gc
= 0;
3528 f
->output_data
.x
->black_relief
.gc
= 0;
3530 /* Create the gray border tile used when the pointer is not in
3531 the frame. Since this depends on the frame's pixel values,
3532 this must be done on a per-frame basis. */
3533 f
->output_data
.x
->border_tile
3534 = (XCreatePixmapFromBitmapData
3535 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3536 gray_bits
, gray_width
, gray_height
,
3537 f
->output_data
.x
->foreground_pixel
,
3538 f
->output_data
.x
->background_pixel
,
3539 DefaultDepth (FRAME_X_DISPLAY (f
),
3540 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3545 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3547 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3548 Returns an Emacs frame object.\n\
3549 ALIST is an alist of frame parameters.\n\
3550 If the parameters specify that the frame should not have a minibuffer,\n\
3551 and do not specify a specific minibuffer window to use,\n\
3552 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3553 be shared by the new frame.\n\
3555 This function is an internal primitive--use `make-frame' instead.")
3560 Lisp_Object frame
, tem
;
3562 int minibuffer_only
= 0;
3563 long window_prompting
= 0;
3565 int count
= specpdl_ptr
- specpdl
;
3566 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3567 Lisp_Object display
;
3568 struct x_display_info
*dpyinfo
= NULL
;
3574 /* Use this general default value to start with
3575 until we know if this frame has a specified name. */
3576 Vx_resource_name
= Vinvocation_name
;
3578 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3579 if (EQ (display
, Qunbound
))
3581 dpyinfo
= check_x_display_info (display
);
3583 kb
= dpyinfo
->kboard
;
3585 kb
= &the_only_kboard
;
3588 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3590 && ! EQ (name
, Qunbound
)
3592 error ("Invalid frame name--not a string or nil");
3595 Vx_resource_name
= name
;
3597 /* See if parent window is specified. */
3598 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3599 if (EQ (parent
, Qunbound
))
3601 if (! NILP (parent
))
3602 CHECK_NUMBER (parent
, 0);
3604 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3605 /* No need to protect DISPLAY because that's not used after passing
3606 it to make_frame_without_minibuffer. */
3608 GCPRO4 (parms
, parent
, name
, frame
);
3609 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3611 if (EQ (tem
, Qnone
) || NILP (tem
))
3612 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3613 else if (EQ (tem
, Qonly
))
3615 f
= make_minibuffer_frame ();
3616 minibuffer_only
= 1;
3618 else if (WINDOWP (tem
))
3619 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3623 XSETFRAME (frame
, f
);
3625 /* Note that X Windows does support scroll bars. */
3626 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3628 f
->output_method
= output_x_window
;
3629 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3630 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3631 f
->output_data
.x
->icon_bitmap
= -1;
3632 f
->output_data
.x
->fontset
= -1;
3633 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3634 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3637 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3639 if (! STRINGP (f
->icon_name
))
3640 f
->icon_name
= Qnil
;
3642 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3644 FRAME_KBOARD (f
) = kb
;
3647 /* Specify the parent under which to make this X window. */
3651 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3652 f
->output_data
.x
->explicit_parent
= 1;
3656 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3657 f
->output_data
.x
->explicit_parent
= 0;
3660 /* Set the name; the functions to which we pass f expect the name to
3662 if (EQ (name
, Qunbound
) || NILP (name
))
3664 f
->name
= build_string (dpyinfo
->x_id_name
);
3665 f
->explicit_name
= 0;
3670 f
->explicit_name
= 1;
3671 /* use the frame's title when getting resources for this frame. */
3672 specbind (Qx_resource_name
, name
);
3675 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3676 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
3677 fs_register_fontset (f
, XCONS (tem
)->car
);
3679 /* Extract the window parameters from the supplied values
3680 that are needed to determine window geometry. */
3684 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3687 /* First, try whatever font the caller has specified. */
3690 tem
= Fquery_fontset (font
, Qnil
);
3692 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3694 font
= x_new_font (f
, XSTRING (font
)->data
);
3697 /* Try out a font which we hope has bold and italic variations. */
3698 if (!STRINGP (font
))
3699 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3700 if (!STRINGP (font
))
3701 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3702 if (! STRINGP (font
))
3703 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3704 if (! STRINGP (font
))
3705 /* This was formerly the first thing tried, but it finds too many fonts
3706 and takes too long. */
3707 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3708 /* If those didn't work, look for something which will at least work. */
3709 if (! STRINGP (font
))
3710 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3712 if (! STRINGP (font
))
3713 font
= build_string ("fixed");
3715 x_default_parameter (f
, parms
, Qfont
, font
,
3716 "font", "Font", RES_TYPE_STRING
);
3720 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3721 whereby it fails to get any font. */
3722 xlwmenu_default_font
= f
->output_data
.x
->font
;
3725 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3726 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3728 /* This defaults to 2 in order to match xterm. We recognize either
3729 internalBorderWidth or internalBorder (which is what xterm calls
3731 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3735 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3736 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3737 if (! EQ (value
, Qunbound
))
3738 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3741 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3742 "internalBorderWidth", "internalBorderWidth",
3744 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3745 "verticalScrollBars", "ScrollBars",
3748 /* Also do the stuff which must be set before the window exists. */
3749 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3750 "foreground", "Foreground", RES_TYPE_STRING
);
3751 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3752 "background", "Background", RES_TYPE_STRING
);
3753 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3754 "pointerColor", "Foreground", RES_TYPE_STRING
);
3755 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3756 "cursorColor", "Foreground", RES_TYPE_STRING
);
3757 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3758 "borderColor", "BorderColor", RES_TYPE_STRING
);
3759 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3760 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3762 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3763 "scrollBarForeground",
3764 "ScrollBarForeground", 1);
3765 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3766 "scrollBarBackground",
3767 "ScrollBarBackground", 0);
3769 /* Init faces before x_default_parameter is called for scroll-bar
3770 parameters because that function calls x_set_scroll_bar_width,
3771 which calls change_frame_size, which calls Fset_window_buffer,
3772 which runs hooks, which call Fvertical_motion. At the end, we
3773 end up in init_iterator with a null face cache, which should not
3775 init_frame_faces (f
);
3777 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3778 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3779 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3780 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3781 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3782 "scrollBarWidth", "ScrollBarWidth",
3784 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3785 "bufferPredicate", "BufferPredicate",
3787 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3788 "title", "Title", RES_TYPE_STRING
);
3790 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3791 window_prompting
= x_figure_window_size (f
, parms
);
3793 if (window_prompting
& XNegative
)
3795 if (window_prompting
& YNegative
)
3796 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3798 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3802 if (window_prompting
& YNegative
)
3803 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3805 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3808 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3810 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3811 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3813 /* Create the X widget or window. Add the tool-bar height to the
3814 initial frame height so that the user gets a text display area of
3815 the size he specified with -g or via .Xdefaults. Later changes
3816 of the tool-bar height don't change the frame size. This is done
3817 so that users can create tall Emacs frames without having to
3818 guess how tall the tool-bar will get. */
3819 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3821 #ifdef USE_X_TOOLKIT
3822 x_window (f
, window_prompting
, minibuffer_only
);
3830 /* Now consider the frame official. */
3831 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3832 Vframe_list
= Fcons (frame
, Vframe_list
);
3834 /* We need to do this after creating the X window, so that the
3835 icon-creation functions can say whose icon they're describing. */
3836 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3837 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3839 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3840 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3841 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3842 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3843 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3844 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3846 /* Dimensions, especially f->height, must be done via change_frame_size.
3847 Change will not be effected unless different from the current
3852 SET_FRAME_WIDTH (f
, 0);
3853 change_frame_size (f
, height
, width
, 1, 0, 0);
3855 /* Set up faces after all frame parameters are known. */
3856 call1 (Qface_set_after_frame_default
, frame
);
3858 #ifdef USE_X_TOOLKIT
3859 /* Create the menu bar. */
3860 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3862 /* If this signals an error, we haven't set size hints for the
3863 frame and we didn't make it visible. */
3864 initialize_frame_menubar (f
);
3866 /* This is a no-op, except under Motif where it arranges the
3867 main window for the widgets on it. */
3868 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3869 f
->output_data
.x
->menubar_widget
,
3870 f
->output_data
.x
->edit_widget
);
3872 #endif /* USE_X_TOOLKIT */
3874 /* Tell the server what size and position, etc, we want, and how
3875 badly we want them. This should be done after we have the menu
3876 bar so that its size can be taken into account. */
3878 x_wm_set_size_hint (f
, window_prompting
, 0);
3881 /* Make the window appear on the frame and enable display, unless
3882 the caller says not to. However, with explicit parent, Emacs
3883 cannot control visibility, so don't try. */
3884 if (! f
->output_data
.x
->explicit_parent
)
3886 Lisp_Object visibility
;
3888 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3890 if (EQ (visibility
, Qunbound
))
3893 if (EQ (visibility
, Qicon
))
3894 x_iconify_frame (f
);
3895 else if (! NILP (visibility
))
3896 x_make_frame_visible (f
);
3898 /* Must have been Qnil. */
3903 return unbind_to (count
, frame
);
3906 /* FRAME is used only to get a handle on the X display. We don't pass the
3907 display info directly because we're called from frame.c, which doesn't
3908 know about that structure. */
3911 x_get_focus_frame (frame
)
3912 struct frame
*frame
;
3914 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3916 if (! dpyinfo
->x_focus_frame
)
3919 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3924 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3925 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3926 If FRAME is omitted or nil, use the selected frame.")
3928 Lisp_Object color
, frame
;
3931 FRAME_PTR f
= check_x_frame (frame
);
3933 CHECK_STRING (color
, 1);
3935 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3941 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3942 "Return a description of the color named COLOR on frame FRAME.\n\
3943 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3944 These values appear to range from 0 to 65280 or 65535, depending\n\
3945 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3946 If FRAME is omitted or nil, use the selected frame.")
3948 Lisp_Object color
, frame
;
3951 FRAME_PTR f
= check_x_frame (frame
);
3953 CHECK_STRING (color
, 1);
3955 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3959 rgb
[0] = make_number (foo
.red
);
3960 rgb
[1] = make_number (foo
.green
);
3961 rgb
[2] = make_number (foo
.blue
);
3962 return Flist (3, rgb
);
3968 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3969 "Return t if the X display supports color.\n\
3970 The optional argument DISPLAY specifies which display to ask about.\n\
3971 DISPLAY should be either a frame or a display name (a string).\n\
3972 If omitted or nil, that stands for the selected frame's display.")
3974 Lisp_Object display
;
3976 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3978 if (dpyinfo
->n_planes
<= 2)
3981 switch (dpyinfo
->visual
->class)
3994 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3996 "Return t if the X display supports shades of gray.\n\
3997 Note that color displays do support shades of gray.\n\
3998 The optional argument DISPLAY specifies which display to ask about.\n\
3999 DISPLAY should be either a frame or a display name (a string).\n\
4000 If omitted or nil, that stands for the selected frame's display.")
4002 Lisp_Object display
;
4004 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4006 if (dpyinfo
->n_planes
<= 1)
4009 switch (dpyinfo
->visual
->class)
4024 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4026 "Returns the width in pixels of the X display DISPLAY.\n\
4027 The optional argument DISPLAY specifies which display to ask about.\n\
4028 DISPLAY should be either a frame or a display name (a string).\n\
4029 If omitted or nil, that stands for the selected frame's display.")
4031 Lisp_Object display
;
4033 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4035 return make_number (dpyinfo
->width
);
4038 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4039 Sx_display_pixel_height
, 0, 1, 0,
4040 "Returns the height in pixels of the X display DISPLAY.\n\
4041 The optional argument DISPLAY specifies which display to ask about.\n\
4042 DISPLAY should be either a frame or a display name (a string).\n\
4043 If omitted or nil, that stands for the selected frame's display.")
4045 Lisp_Object display
;
4047 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4049 return make_number (dpyinfo
->height
);
4052 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4054 "Returns the number of bitplanes of the X display DISPLAY.\n\
4055 The optional argument DISPLAY specifies which display to ask about.\n\
4056 DISPLAY should be either a frame or a display name (a string).\n\
4057 If omitted or nil, that stands for the selected frame's display.")
4059 Lisp_Object display
;
4061 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4063 return make_number (dpyinfo
->n_planes
);
4066 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4068 "Returns the number of color cells of the X display DISPLAY.\n\
4069 The optional argument DISPLAY specifies which display to ask about.\n\
4070 DISPLAY should be either a frame or a display name (a string).\n\
4071 If omitted or nil, that stands for the selected frame's display.")
4073 Lisp_Object display
;
4075 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4077 return make_number (DisplayCells (dpyinfo
->display
,
4078 XScreenNumberOfScreen (dpyinfo
->screen
)));
4081 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4082 Sx_server_max_request_size
,
4084 "Returns the maximum request size of the X server of display DISPLAY.\n\
4085 The optional argument DISPLAY specifies which display to ask about.\n\
4086 DISPLAY should be either a frame or a display name (a string).\n\
4087 If omitted or nil, that stands for the selected frame's display.")
4089 Lisp_Object display
;
4091 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4093 return make_number (MAXREQUEST (dpyinfo
->display
));
4096 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4097 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4098 The optional argument DISPLAY specifies which display to ask about.\n\
4099 DISPLAY should be either a frame or a display name (a string).\n\
4100 If omitted or nil, that stands for the selected frame's display.")
4102 Lisp_Object display
;
4104 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4105 char *vendor
= ServerVendor (dpyinfo
->display
);
4107 if (! vendor
) vendor
= "";
4108 return build_string (vendor
);
4111 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4112 "Returns the version numbers of the X server of display DISPLAY.\n\
4113 The value is a list of three integers: the major and minor\n\
4114 version numbers of the X Protocol in use, and the vendor-specific release\n\
4115 number. See also the function `x-server-vendor'.\n\n\
4116 The optional argument DISPLAY specifies which display to ask about.\n\
4117 DISPLAY should be either a frame or a display name (a string).\n\
4118 If omitted or nil, that stands for the selected frame's display.")
4120 Lisp_Object display
;
4122 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4123 Display
*dpy
= dpyinfo
->display
;
4125 return Fcons (make_number (ProtocolVersion (dpy
)),
4126 Fcons (make_number (ProtocolRevision (dpy
)),
4127 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4130 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4131 "Returns the number of screens on the X server of display DISPLAY.\n\
4132 The optional argument DISPLAY specifies which display to ask about.\n\
4133 DISPLAY should be either a frame or a display name (a string).\n\
4134 If omitted or nil, that stands for the selected frame's display.")
4136 Lisp_Object display
;
4138 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4140 return make_number (ScreenCount (dpyinfo
->display
));
4143 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4144 "Returns the height in millimeters of the X display DISPLAY.\n\
4145 The optional argument DISPLAY specifies which display to ask about.\n\
4146 DISPLAY should be either a frame or a display name (a string).\n\
4147 If omitted or nil, that stands for the selected frame's display.")
4149 Lisp_Object display
;
4151 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4153 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4156 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4157 "Returns the width in millimeters of the X display DISPLAY.\n\
4158 The optional argument DISPLAY specifies which display to ask about.\n\
4159 DISPLAY should be either a frame or a display name (a string).\n\
4160 If omitted or nil, that stands for the selected frame's display.")
4162 Lisp_Object display
;
4164 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4166 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4169 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4170 Sx_display_backing_store
, 0, 1, 0,
4171 "Returns an indication of whether X display DISPLAY does backing store.\n\
4172 The value may be `always', `when-mapped', or `not-useful'.\n\
4173 The optional argument DISPLAY specifies which display to ask about.\n\
4174 DISPLAY should be either a frame or a display name (a string).\n\
4175 If omitted or nil, that stands for the selected frame's display.")
4177 Lisp_Object display
;
4179 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4181 switch (DoesBackingStore (dpyinfo
->screen
))
4184 return intern ("always");
4187 return intern ("when-mapped");
4190 return intern ("not-useful");
4193 error ("Strange value for BackingStore parameter of screen");
4197 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4198 Sx_display_visual_class
, 0, 1, 0,
4199 "Returns the visual class of the X display DISPLAY.\n\
4200 The value is one of the symbols `static-gray', `gray-scale',\n\
4201 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4202 The optional argument DISPLAY specifies which display to ask about.\n\
4203 DISPLAY should be either a frame or a display name (a string).\n\
4204 If omitted or nil, that stands for the selected frame's display.")
4206 Lisp_Object display
;
4208 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4210 switch (dpyinfo
->visual
->class)
4212 case StaticGray
: return (intern ("static-gray"));
4213 case GrayScale
: return (intern ("gray-scale"));
4214 case StaticColor
: return (intern ("static-color"));
4215 case PseudoColor
: return (intern ("pseudo-color"));
4216 case TrueColor
: return (intern ("true-color"));
4217 case DirectColor
: return (intern ("direct-color"));
4219 error ("Display has an unknown visual class");
4223 DEFUN ("x-display-save-under", Fx_display_save_under
,
4224 Sx_display_save_under
, 0, 1, 0,
4225 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4226 The optional argument DISPLAY specifies which display to ask about.\n\
4227 DISPLAY should be either a frame or a display name (a string).\n\
4228 If omitted or nil, that stands for the selected frame's display.")
4230 Lisp_Object display
;
4232 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4234 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4242 register struct frame
*f
;
4244 return PIXEL_WIDTH (f
);
4249 register struct frame
*f
;
4251 return PIXEL_HEIGHT (f
);
4256 register struct frame
*f
;
4258 return FONT_WIDTH (f
->output_data
.x
->font
);
4263 register struct frame
*f
;
4265 return f
->output_data
.x
->line_height
;
4270 register struct frame
*f
;
4272 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4275 #if 0 /* These no longer seem like the right way to do things. */
4277 /* Draw a rectangle on the frame with left top corner including
4278 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4279 CHARS by LINES wide and long and is the color of the cursor. */
4282 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4283 register struct frame
*f
;
4285 register int top_char
, left_char
, chars
, lines
;
4289 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4290 + f
->output_data
.x
->internal_border_width
);
4291 int top
= (top_char
* f
->output_data
.x
->line_height
4292 + f
->output_data
.x
->internal_border_width
);
4295 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4297 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4299 height
= f
->output_data
.x
->line_height
/ 2;
4301 height
= f
->output_data
.x
->line_height
* lines
;
4303 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4304 gc
, left
, top
, width
, height
);
4307 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4308 "Draw a rectangle on FRAME between coordinates specified by\n\
4309 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4310 (frame
, X0
, Y0
, X1
, Y1
)
4311 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4313 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4315 CHECK_LIVE_FRAME (frame
, 0);
4316 CHECK_NUMBER (X0
, 0);
4317 CHECK_NUMBER (Y0
, 1);
4318 CHECK_NUMBER (X1
, 2);
4319 CHECK_NUMBER (Y1
, 3);
4329 n_lines
= y1
- y0
+ 1;
4334 n_lines
= y0
- y1
+ 1;
4340 n_chars
= x1
- x0
+ 1;
4345 n_chars
= x0
- x1
+ 1;
4349 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4350 left
, top
, n_chars
, n_lines
);
4356 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4357 "Draw a rectangle drawn on FRAME between coordinates\n\
4358 X0, Y0, X1, Y1 in the regular background-pixel.")
4359 (frame
, X0
, Y0
, X1
, Y1
)
4360 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4362 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4364 CHECK_LIVE_FRAME (frame
, 0);
4365 CHECK_NUMBER (X0
, 0);
4366 CHECK_NUMBER (Y0
, 1);
4367 CHECK_NUMBER (X1
, 2);
4368 CHECK_NUMBER (Y1
, 3);
4378 n_lines
= y1
- y0
+ 1;
4383 n_lines
= y0
- y1
+ 1;
4389 n_chars
= x1
- x0
+ 1;
4394 n_chars
= x0
- x1
+ 1;
4398 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4399 left
, top
, n_chars
, n_lines
);
4405 /* Draw lines around the text region beginning at the character position
4406 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4407 pixel and line characteristics. */
4409 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4412 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4413 register struct frame
*f
;
4415 int top_x
, top_y
, bottom_x
, bottom_y
;
4417 register int ibw
= f
->output_data
.x
->internal_border_width
;
4418 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4419 register int font_h
= f
->output_data
.x
->line_height
;
4421 int x
= line_len (y
);
4422 XPoint
*pixel_points
4423 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4424 register XPoint
*this_point
= pixel_points
;
4426 /* Do the horizontal top line/lines */
4429 this_point
->x
= ibw
;
4430 this_point
->y
= ibw
+ (font_h
* top_y
);
4433 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4435 this_point
->x
= ibw
+ (font_w
* x
);
4436 this_point
->y
= (this_point
- 1)->y
;
4440 this_point
->x
= ibw
;
4441 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4443 this_point
->x
= ibw
+ (font_w
* top_x
);
4444 this_point
->y
= (this_point
- 1)->y
;
4446 this_point
->x
= (this_point
- 1)->x
;
4447 this_point
->y
= ibw
+ (font_h
* top_y
);
4449 this_point
->x
= ibw
+ (font_w
* x
);
4450 this_point
->y
= (this_point
- 1)->y
;
4453 /* Now do the right side. */
4454 while (y
< bottom_y
)
4455 { /* Right vertical edge */
4457 this_point
->x
= (this_point
- 1)->x
;
4458 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4461 y
++; /* Horizontal connection to next line */
4464 this_point
->x
= ibw
+ (font_w
/ 2);
4466 this_point
->x
= ibw
+ (font_w
* x
);
4468 this_point
->y
= (this_point
- 1)->y
;
4471 /* Now do the bottom and connect to the top left point. */
4472 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4475 this_point
->x
= (this_point
- 1)->x
;
4476 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4478 this_point
->x
= ibw
;
4479 this_point
->y
= (this_point
- 1)->y
;
4481 this_point
->x
= pixel_points
->x
;
4482 this_point
->y
= pixel_points
->y
;
4484 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4486 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4489 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4490 "Highlight the region between point and the character under the mouse\n\
4493 register Lisp_Object event
;
4495 register int x0
, y0
, x1
, y1
;
4496 register struct frame
*f
= selected_frame
;
4497 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4498 register int p1
, p2
;
4500 CHECK_CONS (event
, 0);
4503 x0
= XINT (Fcar (Fcar (event
)));
4504 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4506 /* If the mouse is past the end of the line, don't that area. */
4507 /* ReWrite this... */
4509 /* Where the cursor is. */
4510 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4511 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4513 if (y1
> y0
) /* point below mouse */
4514 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4516 else if (y1
< y0
) /* point above mouse */
4517 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4519 else /* same line: draw horizontal rectangle */
4522 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4523 x0
, y0
, (x1
- x0
+ 1), 1);
4525 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4526 x1
, y1
, (x0
- x1
+ 1), 1);
4529 XFlush (FRAME_X_DISPLAY (f
));
4535 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4536 "Erase any highlighting of the region between point and the character\n\
4537 at X, Y on the selected frame.")
4539 register Lisp_Object event
;
4541 register int x0
, y0
, x1
, y1
;
4542 register struct frame
*f
= selected_frame
;
4543 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4546 x0
= XINT (Fcar (Fcar (event
)));
4547 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4548 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4549 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4551 if (y1
> y0
) /* point below mouse */
4552 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4554 else if (y1
< y0
) /* point above mouse */
4555 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4557 else /* same line: draw horizontal rectangle */
4560 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4561 x0
, y0
, (x1
- x0
+ 1), 1);
4563 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4564 x1
, y1
, (x0
- x1
+ 1), 1);
4572 int contour_begin_x
, contour_begin_y
;
4573 int contour_end_x
, contour_end_y
;
4574 int contour_npoints
;
4576 /* Clip the top part of the contour lines down (and including) line Y_POS.
4577 If X_POS is in the middle (rather than at the end) of the line, drop
4578 down a line at that character. */
4581 clip_contour_top (y_pos
, x_pos
)
4583 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4584 register XPoint
*end
;
4585 register int npoints
;
4586 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4588 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4590 end
= contour_lines
[y_pos
].top_right
;
4591 npoints
= (end
- begin
+ 1);
4592 XDrawLines (x_current_display
, contour_window
,
4593 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4595 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4596 contour_last_point
-= (npoints
- 2);
4597 XDrawLines (x_current_display
, contour_window
,
4598 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4599 XFlush (x_current_display
);
4601 /* Now, update contour_lines structure. */
4606 register XPoint
*p
= begin
+ 1;
4607 end
= contour_lines
[y_pos
].bottom_right
;
4608 npoints
= (end
- begin
+ 1);
4609 XDrawLines (x_current_display
, contour_window
,
4610 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4613 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4615 p
->y
= begin
->y
+ font_h
;
4617 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4618 contour_last_point
-= (npoints
- 5);
4619 XDrawLines (x_current_display
, contour_window
,
4620 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4621 XFlush (x_current_display
);
4623 /* Now, update contour_lines structure. */
4627 /* Erase the top horizontal lines of the contour, and then extend
4628 the contour upwards. */
4631 extend_contour_top (line
)
4636 clip_contour_bottom (x_pos
, y_pos
)
4642 extend_contour_bottom (x_pos
, y_pos
)
4646 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4651 register struct frame
*f
= selected_frame
;
4652 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4653 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4654 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4655 register int mouse_below_point
;
4656 register Lisp_Object obj
;
4657 register int x_contour_x
, x_contour_y
;
4659 x_contour_x
= x_mouse_x
;
4660 x_contour_y
= x_mouse_y
;
4661 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4662 && x_contour_x
> point_x
))
4664 mouse_below_point
= 1;
4665 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4666 x_contour_x
, x_contour_y
);
4670 mouse_below_point
= 0;
4671 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4677 obj
= read_char (-1, 0, 0, Qnil
, 0);
4681 if (mouse_below_point
)
4683 if (x_mouse_y
<= point_y
) /* Flipped. */
4685 mouse_below_point
= 0;
4687 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4688 x_contour_x
, x_contour_y
);
4689 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4692 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4694 clip_contour_bottom (x_mouse_y
);
4696 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4698 extend_bottom_contour (x_mouse_y
);
4701 x_contour_x
= x_mouse_x
;
4702 x_contour_y
= x_mouse_y
;
4704 else /* mouse above or same line as point */
4706 if (x_mouse_y
>= point_y
) /* Flipped. */
4708 mouse_below_point
= 1;
4710 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4711 x_contour_x
, x_contour_y
, point_x
, point_y
);
4712 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4713 x_mouse_x
, x_mouse_y
);
4715 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4717 clip_contour_top (x_mouse_y
);
4719 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4721 extend_contour_top (x_mouse_y
);
4726 unread_command_event
= obj
;
4727 if (mouse_below_point
)
4729 contour_begin_x
= point_x
;
4730 contour_begin_y
= point_y
;
4731 contour_end_x
= x_contour_x
;
4732 contour_end_y
= x_contour_y
;
4736 contour_begin_x
= x_contour_x
;
4737 contour_begin_y
= x_contour_y
;
4738 contour_end_x
= point_x
;
4739 contour_end_y
= point_y
;
4744 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4749 register Lisp_Object obj
;
4750 struct frame
*f
= selected_frame
;
4751 register struct window
*w
= XWINDOW (selected_window
);
4752 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4753 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4755 char dash_list
[] = {6, 4, 6, 4};
4757 XGCValues gc_values
;
4759 register int previous_y
;
4760 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4761 + f
->output_data
.x
->internal_border_width
;
4762 register int left
= f
->output_data
.x
->internal_border_width
4763 + (WINDOW_LEFT_MARGIN (w
)
4764 * FONT_WIDTH (f
->output_data
.x
->font
));
4765 register int right
= left
+ (w
->width
4766 * FONT_WIDTH (f
->output_data
.x
->font
))
4767 - f
->output_data
.x
->internal_border_width
;
4771 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4772 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4773 gc_values
.line_width
= 1;
4774 gc_values
.line_style
= LineOnOffDash
;
4775 gc_values
.cap_style
= CapRound
;
4776 gc_values
.join_style
= JoinRound
;
4778 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4779 GCLineStyle
| GCJoinStyle
| GCCapStyle
4780 | GCLineWidth
| GCForeground
| GCBackground
,
4782 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4783 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4784 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4785 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4786 GCLineStyle
| GCJoinStyle
| GCCapStyle
4787 | GCLineWidth
| GCForeground
| GCBackground
,
4789 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4796 if (x_mouse_y
>= XINT (w
->top
)
4797 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4799 previous_y
= x_mouse_y
;
4800 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4801 + f
->output_data
.x
->internal_border_width
;
4802 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4803 line_gc
, left
, line
, right
, line
);
4805 XFlush (FRAME_X_DISPLAY (f
));
4810 obj
= read_char (-1, 0, 0, Qnil
, 0);
4812 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4813 Qvertical_scroll_bar
))
4817 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4818 erase_gc
, left
, line
, right
, line
);
4819 unread_command_event
= obj
;
4821 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4822 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4828 while (x_mouse_y
== previous_y
);
4831 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4832 erase_gc
, left
, line
, right
, line
);
4839 /* These keep track of the rectangle following the pointer. */
4840 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4842 /* Offset in buffer of character under the pointer, or 0. */
4843 int mouse_buffer_offset
;
4845 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4846 "Track the pointer.")
4849 static Cursor current_pointer_shape
;
4850 FRAME_PTR f
= x_mouse_frame
;
4853 if (EQ (Vmouse_frame_part
, Qtext_part
)
4854 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4859 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4860 XDefineCursor (FRAME_X_DISPLAY (f
),
4862 current_pointer_shape
);
4864 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4865 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4867 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4868 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4870 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4871 XDefineCursor (FRAME_X_DISPLAY (f
),
4873 current_pointer_shape
);
4876 XFlush (FRAME_X_DISPLAY (f
));
4882 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4883 "Draw rectangle around character under mouse pointer, if there is one.")
4887 struct window
*w
= XWINDOW (Vmouse_window
);
4888 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4889 struct buffer
*b
= XBUFFER (w
->buffer
);
4892 if (! EQ (Vmouse_window
, selected_window
))
4895 if (EQ (event
, Qnil
))
4899 x_read_mouse_position (selected_frame
, &x
, &y
);
4903 mouse_track_width
= 0;
4904 mouse_track_left
= mouse_track_top
= -1;
4908 if ((x_mouse_x
!= mouse_track_left
4909 && (x_mouse_x
< mouse_track_left
4910 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4911 || x_mouse_y
!= mouse_track_top
)
4913 int hp
= 0; /* Horizontal position */
4914 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4915 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4916 int tab_width
= XINT (b
->tab_width
);
4917 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4919 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4920 int in_mode_line
= 0;
4922 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4925 /* Erase previous rectangle. */
4926 if (mouse_track_width
)
4928 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4929 mouse_track_left
, mouse_track_top
,
4930 mouse_track_width
, 1);
4932 if ((mouse_track_left
== f
->phys_cursor_x
4933 || mouse_track_left
== f
->phys_cursor_x
- 1)
4934 && mouse_track_top
== f
->phys_cursor_y
)
4936 x_display_cursor (f
, 1);
4940 mouse_track_left
= x_mouse_x
;
4941 mouse_track_top
= x_mouse_y
;
4942 mouse_track_width
= 0;
4944 if (mouse_track_left
> len
) /* Past the end of line. */
4947 if (mouse_track_top
== mode_line_vpos
)
4953 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4957 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4963 mouse_track_width
= tab_width
- (hp
% tab_width
);
4965 hp
+= mouse_track_width
;
4968 mouse_track_left
= hp
- mouse_track_width
;
4974 mouse_track_width
= -1;
4978 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4983 mouse_track_width
= 2;
4988 mouse_track_left
= hp
- mouse_track_width
;
4994 mouse_track_width
= 1;
5001 while (hp
<= x_mouse_x
);
5004 if (mouse_track_width
) /* Over text; use text pointer shape. */
5006 XDefineCursor (FRAME_X_DISPLAY (f
),
5008 f
->output_data
.x
->text_cursor
);
5009 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
5010 mouse_track_left
, mouse_track_top
,
5011 mouse_track_width
, 1);
5013 else if (in_mode_line
)
5014 XDefineCursor (FRAME_X_DISPLAY (f
),
5016 f
->output_data
.x
->modeline_cursor
);
5018 XDefineCursor (FRAME_X_DISPLAY (f
),
5020 f
->output_data
.x
->nontext_cursor
);
5023 XFlush (FRAME_X_DISPLAY (f
));
5026 obj
= read_char (-1, 0, 0, Qnil
, 0);
5029 while (CONSP (obj
) /* Mouse event */
5030 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5031 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5032 && EQ (Vmouse_window
, selected_window
) /* In this window */
5035 unread_command_event
= obj
;
5037 if (mouse_track_width
)
5039 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5040 mouse_track_left
, mouse_track_top
,
5041 mouse_track_width
, 1);
5042 mouse_track_width
= 0;
5043 if ((mouse_track_left
== f
->phys_cursor_x
5044 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5045 && mouse_track_top
== f
->phys_cursor_y
)
5047 x_display_cursor (f
, 1);
5050 XDefineCursor (FRAME_X_DISPLAY (f
),
5052 f
->output_data
.x
->nontext_cursor
);
5053 XFlush (FRAME_X_DISPLAY (f
));
5063 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5064 on the frame F at position X, Y. */
5066 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5068 int x
, y
, width
, height
;
5073 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5074 FRAME_X_WINDOW (f
), image_data
,
5076 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5077 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5081 #if 0 /* I'm told these functions are superfluous
5082 given the ability to bind function keys. */
5085 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5086 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5087 KEYSYM is a string which conforms to the X keysym definitions found\n\
5088 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5089 list of strings specifying modifier keys such as Control_L, which must\n\
5090 also be depressed for NEWSTRING to appear.")
5091 (x_keysym
, modifiers
, newstring
)
5092 register Lisp_Object x_keysym
;
5093 register Lisp_Object modifiers
;
5094 register Lisp_Object newstring
;
5097 register KeySym keysym
;
5098 KeySym modifier_list
[16];
5101 CHECK_STRING (x_keysym
, 1);
5102 CHECK_STRING (newstring
, 3);
5104 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5105 if (keysym
== NoSymbol
)
5106 error ("Keysym does not exist");
5108 if (NILP (modifiers
))
5109 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5110 XSTRING (newstring
)->data
,
5111 STRING_BYTES (XSTRING (newstring
)));
5114 register Lisp_Object rest
, mod
;
5117 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5120 error ("Can't have more than 16 modifiers");
5123 CHECK_STRING (mod
, 3);
5124 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5126 if (modifier_list
[i
] == NoSymbol
5127 || !(IsModifierKey (modifier_list
[i
])
5128 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5129 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5131 if (modifier_list
[i
] == NoSymbol
5132 || !IsModifierKey (modifier_list
[i
]))
5134 error ("Element is not a modifier keysym");
5138 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5139 XSTRING (newstring
)->data
,
5140 STRING_BYTES (XSTRING (newstring
)));
5146 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5147 "Rebind KEYCODE to list of strings STRINGS.\n\
5148 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5149 nil as element means don't change.\n\
5150 See the documentation of `x-rebind-key' for more information.")
5152 register Lisp_Object keycode
;
5153 register Lisp_Object strings
;
5155 register Lisp_Object item
;
5156 register unsigned char *rawstring
;
5157 KeySym rawkey
, modifier
[1];
5159 register unsigned i
;
5162 CHECK_NUMBER (keycode
, 1);
5163 CHECK_CONS (strings
, 2);
5164 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5165 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5167 item
= Fcar (strings
);
5170 CHECK_STRING (item
, 2);
5171 strsize
= STRING_BYTES (XSTRING (item
));
5172 rawstring
= (unsigned char *) xmalloc (strsize
);
5173 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5174 modifier
[1] = 1 << i
;
5175 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5176 rawstring
, strsize
);
5181 #endif /* HAVE_X11 */
5184 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5186 XScreenNumberOfScreen (scr
)
5187 register Screen
*scr
;
5189 register Display
*dpy
;
5190 register Screen
*dpyscr
;
5194 dpyscr
= dpy
->screens
;
5196 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5202 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5205 select_visual (dpy
, screen
, depth
)
5208 unsigned int *depth
;
5211 XVisualInfo
*vinfo
, vinfo_template
;
5214 v
= DefaultVisualOfScreen (screen
);
5217 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5219 vinfo_template
.visualid
= v
->visualid
;
5222 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5224 vinfo
= XGetVisualInfo (dpy
,
5225 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5228 fatal ("Can't get proper X visual info");
5230 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5231 *depth
= vinfo
->depth
;
5235 int n
= vinfo
->colormap_size
- 1;
5244 XFree ((char *) vinfo
);
5248 /* Return the X display structure for the display named NAME.
5249 Open a new connection if necessary. */
5251 struct x_display_info
*
5252 x_display_info_for_name (name
)
5256 struct x_display_info
*dpyinfo
;
5258 CHECK_STRING (name
, 0);
5260 if (! EQ (Vwindow_system
, intern ("x")))
5261 error ("Not using X Windows");
5263 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5265 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
5268 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
5273 /* Use this general default value to start with. */
5274 Vx_resource_name
= Vinvocation_name
;
5276 validate_x_resource_name ();
5278 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5279 (char *) XSTRING (Vx_resource_name
)->data
);
5282 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5285 XSETFASTINT (Vwindow_system_version
, 11);
5290 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5291 1, 3, 0, "Open a connection to an X server.\n\
5292 DISPLAY is the name of the display to connect to.\n\
5293 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5294 If the optional third arg MUST-SUCCEED is non-nil,\n\
5295 terminate Emacs if we can't open the connection.")
5296 (display
, xrm_string
, must_succeed
)
5297 Lisp_Object display
, xrm_string
, must_succeed
;
5299 unsigned char *xrm_option
;
5300 struct x_display_info
*dpyinfo
;
5302 CHECK_STRING (display
, 0);
5303 if (! NILP (xrm_string
))
5304 CHECK_STRING (xrm_string
, 1);
5306 if (! EQ (Vwindow_system
, intern ("x")))
5307 error ("Not using X Windows");
5309 if (! NILP (xrm_string
))
5310 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5312 xrm_option
= (unsigned char *) 0;
5314 validate_x_resource_name ();
5316 /* This is what opens the connection and sets x_current_display.
5317 This also initializes many symbols, such as those used for input. */
5318 dpyinfo
= x_term_init (display
, xrm_option
,
5319 (char *) XSTRING (Vx_resource_name
)->data
);
5323 if (!NILP (must_succeed
))
5324 fatal ("Cannot connect to X server %s.\n\
5325 Check the DISPLAY environment variable or use `-d'.\n\
5326 Also use the `xhost' program to verify that it is set to permit\n\
5327 connections from your machine.\n",
5328 XSTRING (display
)->data
);
5330 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5335 XSETFASTINT (Vwindow_system_version
, 11);
5339 DEFUN ("x-close-connection", Fx_close_connection
,
5340 Sx_close_connection
, 1, 1, 0,
5341 "Close the connection to DISPLAY's X server.\n\
5342 For DISPLAY, specify either a frame or a display name (a string).\n\
5343 If DISPLAY is nil, that stands for the selected frame's display.")
5345 Lisp_Object display
;
5347 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5350 if (dpyinfo
->reference_count
> 0)
5351 error ("Display still has frames on it");
5354 /* Free the fonts in the font table. */
5355 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5356 if (dpyinfo
->font_table
[i
].name
)
5358 xfree (dpyinfo
->font_table
[i
].name
);
5359 /* Don't free the full_name string;
5360 it is always shared with something else. */
5361 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5364 x_destroy_all_bitmaps (dpyinfo
);
5365 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5367 #ifdef USE_X_TOOLKIT
5368 XtCloseDisplay (dpyinfo
->display
);
5370 XCloseDisplay (dpyinfo
->display
);
5373 x_delete_display (dpyinfo
);
5379 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5380 "Return the list of display names that Emacs has connections to.")
5383 Lisp_Object tail
, result
;
5386 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
5387 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
5392 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5393 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5394 If ON is nil, allow buffering of requests.\n\
5395 Turning on synchronization prohibits the Xlib routines from buffering\n\
5396 requests and seriously degrades performance, but makes debugging much\n\
5398 The optional second argument DISPLAY specifies which display to act on.\n\
5399 DISPLAY should be either a frame or a display name (a string).\n\
5400 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5402 Lisp_Object display
, on
;
5404 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5406 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5411 /* Wait for responses to all X commands issued so far for frame F. */
5418 XSync (FRAME_X_DISPLAY (f
), False
);
5423 /***********************************************************************
5425 ***********************************************************************/
5427 /* Value is the number of elements of vector VECTOR. */
5429 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5431 /* List of supported image types. Use define_image_type to add new
5432 types. Use lookup_image_type to find a type for a given symbol. */
5434 static struct image_type
*image_types
;
5436 /* A list of symbols, one for each supported image type. */
5438 Lisp_Object Vimage_types
;
5440 /* The symbol `image' which is the car of the lists used to represent
5443 extern Lisp_Object Qimage
;
5445 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5451 Lisp_Object QCtype
, QCdata
, QCfile
, QCascent
, QCmargin
, QCrelief
;
5452 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
;
5453 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5454 Lisp_Object QCindex
;
5456 /* Other symbols. */
5458 Lisp_Object Qlaplace
;
5460 /* Time in seconds after which images should be removed from the cache
5461 if not displayed. */
5463 Lisp_Object Vimage_eviction_seconds
;
5465 /* Function prototypes. */
5467 static void define_image_type
P_ ((struct image_type
*type
));
5468 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5469 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5470 static void x_laplace
P_ ((struct frame
*, struct image
*));
5471 static int x_build_heuristic_mask
P_ ((struct frame
*, Lisp_Object
,
5472 struct image
*, Lisp_Object
));
5475 /* Define a new image type from TYPE. This adds a copy of TYPE to
5476 image_types and adds the symbol *TYPE->type to Vimage_types. */
5479 define_image_type (type
)
5480 struct image_type
*type
;
5482 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5483 The initialized data segment is read-only. */
5484 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5485 bcopy (type
, p
, sizeof *p
);
5486 p
->next
= image_types
;
5488 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5492 /* Look up image type SYMBOL, and return a pointer to its image_type
5493 structure. Value is null if SYMBOL is not a known image type. */
5495 static INLINE
struct image_type
*
5496 lookup_image_type (symbol
)
5499 struct image_type
*type
;
5501 for (type
= image_types
; type
; type
= type
->next
)
5502 if (EQ (symbol
, *type
->type
))
5509 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5510 valid image specification is a list whose car is the symbol
5511 `image', and whose rest is a property list. The property list must
5512 contain a value for key `:type'. That value must be the name of a
5513 supported image type. The rest of the property list depends on the
5517 valid_image_p (object
)
5522 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5524 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5525 struct image_type
*type
= lookup_image_type (symbol
);
5528 valid_p
= type
->valid_p (object
);
5535 /* Display an error message with format string FORMAT and argument
5536 ARG. Signaling an error, e.g. when an image cannot be loaded,
5537 is not a good idea because this would interrupt redisplay, and
5538 the error message display would lead to another redisplay. This
5539 function therefore simply displays a message. */
5542 image_error (format
, arg1
, arg2
)
5544 Lisp_Object arg1
, arg2
;
5546 Lisp_Object args
[3];
5548 args
[0] = build_string (format
);
5551 Fmessage (make_number (DIM (args
)), args
);
5556 /***********************************************************************
5557 Image specifications
5558 ***********************************************************************/
5560 enum image_value_type
5562 IMAGE_DONT_CHECK_VALUE_TYPE
,
5565 IMAGE_POSITIVE_INTEGER_VALUE
,
5566 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5567 IMAGE_INTEGER_VALUE
,
5568 IMAGE_FUNCTION_VALUE
,
5573 /* Structure used when parsing image specifications. */
5575 struct image_keyword
5577 /* Name of keyword. */
5580 /* The type of value allowed. */
5581 enum image_value_type type
;
5583 /* Non-zero means key must be present. */
5586 /* Used to recognize duplicate keywords in a property list. */
5589 /* The value that was found. */
5594 static int parse_image_spec
P_ ((Lisp_Object spec
,
5595 struct image_keyword
*keywords
,
5596 int nkeywords
, Lisp_Object type
,
5597 int allow_other_keys_p
));
5598 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5601 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5602 has the format (image KEYWORD VALUE ...). One of the keyword/
5603 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5604 image_keywords structures of size NKEYWORDS describing other
5605 allowed keyword/value pairs. ALLOW_OTHER_KEYS_P non-zero means
5606 allow KEYWORD/VALUE pairs other than those described by KEYWORDS
5607 without checking them. Value is non-zero if SPEC is valid. */
5610 parse_image_spec (spec
, keywords
, nkeywords
, type
, allow_other_keys_p
)
5612 struct image_keyword
*keywords
;
5615 int allow_other_keys_p
;
5620 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5623 plist
= XCDR (spec
);
5624 while (CONSP (plist
))
5626 Lisp_Object key
, value
;
5628 /* First element of a pair must be a symbol. */
5630 plist
= XCDR (plist
);
5634 /* There must follow a value. */
5637 value
= XCAR (plist
);
5638 plist
= XCDR (plist
);
5640 /* Find key in KEYWORDS. Error if not found. */
5641 for (i
= 0; i
< nkeywords
; ++i
)
5642 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5647 if (!allow_other_keys_p
)
5652 /* Record that we recognized the keyword. If a keywords
5653 was found more than once, it's an error. */
5654 keywords
[i
].value
= value
;
5655 ++keywords
[i
].count
;
5657 if (keywords
[i
].count
> 1)
5660 /* Check type of value against allowed type. */
5661 switch (keywords
[i
].type
)
5663 case IMAGE_STRING_VALUE
:
5664 if (!STRINGP (value
))
5668 case IMAGE_SYMBOL_VALUE
:
5669 if (!SYMBOLP (value
))
5673 case IMAGE_POSITIVE_INTEGER_VALUE
:
5674 if (!INTEGERP (value
) || XINT (value
) <= 0)
5678 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5679 if (!INTEGERP (value
) || XINT (value
) < 0)
5683 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5686 case IMAGE_FUNCTION_VALUE
:
5687 value
= indirect_function (value
);
5689 || COMPILEDP (value
)
5690 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5694 case IMAGE_NUMBER_VALUE
:
5695 if (!INTEGERP (value
) && !FLOATP (value
))
5699 case IMAGE_INTEGER_VALUE
:
5700 if (!INTEGERP (value
))
5704 case IMAGE_BOOL_VALUE
:
5705 if (!NILP (value
) && !EQ (value
, Qt
))
5714 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5718 /* Check that all mandatory fields are present. */
5719 for (i
= 0; i
< nkeywords
; ++i
)
5720 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5723 return NILP (plist
);
5727 /* Return the value of KEY in image specification SPEC. Value is nil
5728 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5729 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5732 image_spec_value (spec
, key
, found
)
5733 Lisp_Object spec
, key
;
5738 xassert (valid_image_p (spec
));
5740 for (tail
= XCDR (spec
);
5741 CONSP (tail
) && CONSP (XCDR (tail
));
5742 tail
= XCDR (XCDR (tail
)))
5744 if (EQ (XCAR (tail
), key
))
5748 return XCAR (XCDR (tail
));
5760 /***********************************************************************
5761 Image type independent image structures
5762 ***********************************************************************/
5764 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5765 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5768 /* Allocate and return a new image structure for image specification
5769 SPEC. SPEC has a hash value of HASH. */
5771 static struct image
*
5772 make_image (spec
, hash
)
5776 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5778 xassert (valid_image_p (spec
));
5779 bzero (img
, sizeof *img
);
5780 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5781 xassert (img
->type
!= NULL
);
5783 img
->data
.lisp_val
= Qnil
;
5784 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5790 /* Free image IMG which was used on frame F, including its resources. */
5799 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5801 /* Remove IMG from the hash table of its cache. */
5803 img
->prev
->next
= img
->next
;
5805 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5808 img
->next
->prev
= img
->prev
;
5810 c
->images
[img
->id
] = NULL
;
5812 /* Free resources, then free IMG. */
5813 img
->type
->free (f
, img
);
5819 /* Prepare image IMG for display on frame F. Must be called before
5820 drawing an image. */
5823 prepare_image_for_display (f
, img
)
5829 /* We're about to display IMG, so set its timestamp to `now'. */
5831 img
->timestamp
= EMACS_SECS (t
);
5833 /* If IMG doesn't have a pixmap yet, load it now, using the image
5834 type dependent loader function. */
5835 if (img
->pixmap
== 0)
5836 img
->type
->load (f
, img
);
5841 /***********************************************************************
5842 Helper functions for X image types
5843 ***********************************************************************/
5845 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5846 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5848 Lisp_Object color_name
,
5849 unsigned long dflt
));
5851 /* Free X resources of image IMG which is used on frame F. */
5854 x_clear_image (f
, img
)
5861 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5868 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5870 /* If display has an immutable color map, freeing colors is not
5871 necessary and some servers don't allow it. So don't do it. */
5872 if (class != StaticColor
5873 && class != StaticGray
5874 && class != TrueColor
)
5878 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5879 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5884 xfree (img
->colors
);
5891 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5892 cannot be allocated, use DFLT. Add a newly allocated color to
5893 IMG->colors, so that it can be freed again. Value is the pixel
5896 static unsigned long
5897 x_alloc_image_color (f
, img
, color_name
, dflt
)
5900 Lisp_Object color_name
;
5904 unsigned long result
;
5906 xassert (STRINGP (color_name
));
5908 if (defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5910 /* This isn't called frequently so we get away with simply
5911 reallocating the color vector to the needed size, here. */
5914 (unsigned long *) xrealloc (img
->colors
,
5915 img
->ncolors
* sizeof *img
->colors
);
5916 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5917 result
= color
.pixel
;
5927 /***********************************************************************
5929 ***********************************************************************/
5931 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5934 /* Return a new, initialized image cache that is allocated from the
5935 heap. Call free_image_cache to free an image cache. */
5937 struct image_cache
*
5940 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5943 bzero (c
, sizeof *c
);
5945 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5946 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5947 c
->buckets
= (struct image
**) xmalloc (size
);
5948 bzero (c
->buckets
, size
);
5953 /* Free image cache of frame F. Be aware that X frames share images
5957 free_image_cache (f
)
5960 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5965 /* Cache should not be referenced by any frame when freed. */
5966 xassert (c
->refcount
== 0);
5968 for (i
= 0; i
< c
->used
; ++i
)
5969 free_image (f
, c
->images
[i
]);
5973 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5978 /* Clear image cache of frame F. FORCE_P non-zero means free all
5979 images. FORCE_P zero means clear only images that haven't been
5980 displayed for some time. Should be called from time to time to
5981 reduce the number of loaded images. If image-eviction-seconds is
5982 non-nil, this frees images in the cache which weren't displayed for
5983 at least that many seconds. */
5986 clear_image_cache (f
, force_p
)
5990 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5992 if (c
&& INTEGERP (Vimage_eviction_seconds
))
5996 int i
, any_freed_p
= 0;
5999 old
= EMACS_SECS (t
) - XFASTINT (Vimage_eviction_seconds
);
6001 for (i
= 0; i
< c
->used
; ++i
)
6003 struct image
*img
= c
->images
[i
];
6006 || (img
->timestamp
> old
)))
6008 free_image (f
, img
);
6013 /* We may be clearing the image cache because, for example,
6014 Emacs was iconified for a longer period of time. In that
6015 case, current matrices may still contain references to
6016 images freed above. So, clear these matrices. */
6019 clear_current_matrices (f
);
6020 ++windows_or_buffers_changed
;
6026 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6028 "Clear the image cache of FRAME.\n\
6029 FRAME nil or omitted means use the selected frame.\n\
6030 FRAME t means clear the image caches of all frames.")
6038 FOR_EACH_FRAME (tail
, frame
)
6039 if (FRAME_X_P (XFRAME (frame
)))
6040 clear_image_cache (XFRAME (frame
), 1);
6043 clear_image_cache (check_x_frame (frame
), 1);
6049 /* Return the id of image with Lisp specification SPEC on frame F.
6050 SPEC must be a valid Lisp image specification (see valid_image_p). */
6053 lookup_image (f
, spec
)
6057 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6061 struct gcpro gcpro1
;
6063 /* F must be a window-system frame, and SPEC must be a valid image
6065 xassert (FRAME_WINDOW_P (f
));
6066 xassert (valid_image_p (spec
));
6070 /* Look up SPEC in the hash table of the image cache. */
6071 hash
= sxhash (spec
, 0);
6072 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6074 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6075 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6078 /* If not found, create a new image and cache it. */
6081 extern Lisp_Object QCenable
, QCselect
;
6083 int loading_failed_p
;
6085 img
= make_image (spec
, hash
);
6086 cache_image (f
, img
);
6087 loading_failed_p
= img
->type
->load (f
, img
) == 0;
6089 /* If we can't load the image, and we don't have a width and
6090 height, use some arbitrary width and height so that we can
6091 draw a rectangle for it. */
6092 if (loading_failed_p
)
6096 value
= image_spec_value (spec
, QCwidth
, NULL
);
6097 img
->width
= (INTEGERP (value
)
6098 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6099 value
= image_spec_value (spec
, QCheight
, NULL
);
6100 img
->height
= (INTEGERP (value
)
6101 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6105 /* Handle image type independent image attributes
6106 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6107 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6110 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6111 if (INTEGERP (ascent
))
6112 img
->ascent
= XFASTINT (ascent
);
6114 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6115 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6116 img
->margin
= XFASTINT (margin
);
6118 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6119 if (INTEGERP (relief
))
6121 img
->relief
= XINT (relief
);
6122 img
->margin
+= abs (img
->relief
);
6125 /* Should we apply a Laplace edge-detection algorithm? */
6126 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6127 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6130 /* Should we built a mask heuristically? */
6131 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6132 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6134 file
= image_spec_value (spec
, QCfile
, NULL
);
6135 x_build_heuristic_mask (f
, file
, img
, heuristic_mask
);
6142 /* Value is the image id. */
6147 /* Cache image IMG in the image cache of frame F. */
6150 cache_image (f
, img
)
6154 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6157 /* Find a free slot in c->images. */
6158 for (i
= 0; i
< c
->used
; ++i
)
6159 if (c
->images
[i
] == NULL
)
6162 /* If no free slot found, maybe enlarge c->images. */
6163 if (i
== c
->used
&& c
->used
== c
->size
)
6166 c
->images
= (struct image
**) xrealloc (c
->images
,
6167 c
->size
* sizeof *c
->images
);
6170 /* Add IMG to c->images, and assign IMG an id. */
6176 /* Add IMG to the cache's hash table. */
6177 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6178 img
->next
= c
->buckets
[i
];
6180 img
->next
->prev
= img
;
6182 c
->buckets
[i
] = img
;
6186 /* Call FN on every image in the image cache of frame F. Used to mark
6187 Lisp Objects in the image cache. */
6190 forall_images_in_image_cache (f
, fn
)
6192 void (*fn
) P_ ((struct image
*img
));
6194 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6196 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6200 for (i
= 0; i
< c
->used
; ++i
)
6209 /***********************************************************************
6211 ***********************************************************************/
6213 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, Lisp_Object
,
6214 int, int, int, XImage
**,
6216 static void x_destroy_x_image
P_ ((XImage
*));
6217 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6220 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6221 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6222 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6223 via xmalloc. Print error messages via image_error if an error
6224 occurs. FILE is the name of an image file being processed, for
6225 error messages. Value is non-zero if successful. */
6228 x_create_x_image_and_pixmap (f
, file
, width
, height
, depth
, ximg
, pixmap
)
6231 int width
, height
, depth
;
6235 Display
*display
= FRAME_X_DISPLAY (f
);
6236 Screen
*screen
= FRAME_X_SCREEN (f
);
6237 Window window
= FRAME_X_WINDOW (f
);
6239 xassert (interrupt_input_blocked
);
6242 depth
= DefaultDepthOfScreen (screen
);
6243 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6244 depth
, ZPixmap
, 0, NULL
, width
, height
,
6245 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6248 image_error ("Unable to allocate X image for %s", file
, Qnil
);
6252 /* Allocate image raster. */
6253 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6255 /* Allocate a pixmap of the same size. */
6256 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6259 x_destroy_x_image (*ximg
);
6261 image_error ("Unable to create pixmap for `%s'", file
, Qnil
);
6269 /* Destroy XImage XIMG. Free XIMG->data. */
6272 x_destroy_x_image (ximg
)
6275 xassert (interrupt_input_blocked
);
6280 XDestroyImage (ximg
);
6285 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6286 are width and height of both the image and pixmap. */
6289 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6296 xassert (interrupt_input_blocked
);
6297 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6298 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6299 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6304 /***********************************************************************
6306 ***********************************************************************/
6308 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6310 /* Find image file FILE. Look in data-directory, then
6311 x-bitmap-file-path. Value is the full name of the file found, or
6312 nil if not found. */
6315 x_find_image_file (file
)
6318 Lisp_Object file_found
, search_path
;
6319 struct gcpro gcpro1
, gcpro2
;
6323 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6324 GCPRO2 (file_found
, search_path
);
6326 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6327 fd
= openp (search_path
, file
, "", &file_found
, 0);
6340 /***********************************************************************
6342 ***********************************************************************/
6344 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6345 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6347 static int xbm_image_p
P_ ((Lisp_Object object
));
6348 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6350 static int xbm_read_hexint
P_ ((FILE *));
6353 /* Indices of image specification fields in xbm_format, below. */
6355 enum xbm_keyword_index
6372 /* Vector of image_keyword structures describing the format
6373 of valid XBM image specifications. */
6375 static struct image_keyword xbm_format
[XBM_LAST
] =
6377 {":type", IMAGE_SYMBOL_VALUE
, 1},
6378 {":file", IMAGE_STRING_VALUE
, 0},
6379 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6380 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6381 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6382 {":foreground", IMAGE_STRING_VALUE
, 0},
6383 {":background", IMAGE_STRING_VALUE
, 0},
6384 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6385 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6386 {":relief", IMAGE_INTEGER_VALUE
, 0},
6387 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6388 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6391 /* Structure describing the image type XBM. */
6393 static struct image_type xbm_type
=
6402 /* Tokens returned from xbm_scan. */
6411 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6412 A valid specification is a list starting with the symbol `image'
6413 The rest of the list is a property list which must contain an
6416 If the specification specifies a file to load, it must contain
6417 an entry `:file FILENAME' where FILENAME is a string.
6419 If the specification is for a bitmap loaded from memory it must
6420 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6421 WIDTH and HEIGHT are integers > 0. DATA may be:
6423 1. a string large enough to hold the bitmap data, i.e. it must
6424 have a size >= (WIDTH + 7) / 8 * HEIGHT
6426 2. a bool-vector of size >= WIDTH * HEIGHT
6428 3. a vector of strings or bool-vectors, one for each line of the
6431 Both the file and data forms may contain the additional entries
6432 `:background COLOR' and `:foreground COLOR'. If not present,
6433 foreground and background of the frame on which the image is
6434 displayed, is used. */
6437 xbm_image_p (object
)
6440 struct image_keyword kw
[XBM_LAST
];
6442 bcopy (xbm_format
, kw
, sizeof kw
);
6443 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
, 0))
6446 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6448 if (kw
[XBM_FILE
].count
)
6450 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6458 /* Entries for `:width', `:height' and `:data' must be present. */
6459 if (!kw
[XBM_WIDTH
].count
6460 || !kw
[XBM_HEIGHT
].count
6461 || !kw
[XBM_DATA
].count
)
6464 data
= kw
[XBM_DATA
].value
;
6465 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6466 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6468 /* Check type of data, and width and height against contents of
6474 /* Number of elements of the vector must be >= height. */
6475 if (XVECTOR (data
)->size
< height
)
6478 /* Each string or bool-vector in data must be large enough
6479 for one line of the image. */
6480 for (i
= 0; i
< height
; ++i
)
6482 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6486 if (XSTRING (elt
)->size
6487 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6490 else if (BOOL_VECTOR_P (elt
))
6492 if (XBOOL_VECTOR (elt
)->size
< width
)
6499 else if (STRINGP (data
))
6501 if (XSTRING (data
)->size
6502 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6505 else if (BOOL_VECTOR_P (data
))
6507 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6514 /* Baseline must be a value between 0 and 100 (a percentage). */
6515 if (kw
[XBM_ASCENT
].count
6516 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6523 /* Scan a bitmap file. FP is the stream to read from. Value is
6524 either an enumerator from enum xbm_token, or a character for a
6525 single-character token, or 0 at end of file. If scanning an
6526 identifier, store the lexeme of the identifier in SVAL. If
6527 scanning a number, store its value in *IVAL. */
6530 xbm_scan (fp
, sval
, ival
)
6537 /* Skip white space. */
6538 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6543 else if (isdigit (c
))
6545 int value
= 0, digit
;
6550 if (c
== 'x' || c
== 'X')
6552 while ((c
= fgetc (fp
)) != EOF
)
6556 else if (c
>= 'a' && c
<= 'f')
6557 digit
= c
- 'a' + 10;
6558 else if (c
>= 'A' && c
<= 'F')
6559 digit
= c
- 'A' + 10;
6562 value
= 16 * value
+ digit
;
6565 else if (isdigit (c
))
6568 while ((c
= fgetc (fp
)) != EOF
6570 value
= 8 * value
+ c
- '0';
6576 while ((c
= fgetc (fp
)) != EOF
6578 value
= 10 * value
+ c
- '0';
6586 else if (isalpha (c
) || c
== '_')
6589 while ((c
= fgetc (fp
)) != EOF
6590 && (isalnum (c
) || c
== '_'))
6602 /* Replacement for XReadBitmapFileData which isn't available under old
6603 X versions. FILE is the name of the bitmap file to read. Set
6604 *WIDTH and *HEIGHT to the width and height of the image. Return in
6605 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6609 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6611 int *width
, *height
;
6612 unsigned char **data
;
6615 char buffer
[BUFSIZ
];
6618 int bytes_per_line
, i
, nbytes
;
6624 LA1 = xbm_scan (fp, buffer, &value)
6626 #define expect(TOKEN) \
6627 if (LA1 != (TOKEN)) \
6632 #define expect_ident(IDENT) \
6633 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6638 fp
= fopen (file
, "r");
6642 *width
= *height
= -1;
6644 LA1
= xbm_scan (fp
, buffer
, &value
);
6646 /* Parse defines for width, height and hot-spots. */
6652 expect_ident ("define");
6653 expect (XBM_TK_IDENT
);
6655 if (LA1
== XBM_TK_NUMBER
);
6657 char *p
= strrchr (buffer
, '_');
6658 p
= p
? p
+ 1 : buffer
;
6659 if (strcmp (p
, "width") == 0)
6661 else if (strcmp (p
, "height") == 0)
6664 expect (XBM_TK_NUMBER
);
6667 if (*width
< 0 || *height
< 0)
6670 /* Parse bits. Must start with `static'. */
6671 expect_ident ("static");
6672 if (LA1
== XBM_TK_IDENT
)
6674 if (strcmp (buffer
, "unsigned") == 0)
6677 expect_ident ("char");
6679 else if (strcmp (buffer
, "short") == 0)
6683 if (*width
% 16 && *width
% 16 < 9)
6686 else if (strcmp (buffer
, "char") == 0)
6694 expect (XBM_TK_IDENT
);
6700 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6701 nbytes
= bytes_per_line
* *height
;
6702 p
= *data
= (char *) xmalloc (nbytes
);
6707 for (i
= 0; i
< nbytes
; i
+= 2)
6710 expect (XBM_TK_NUMBER
);
6713 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6716 if (LA1
== ',' || LA1
== '}')
6724 for (i
= 0; i
< nbytes
; ++i
)
6727 expect (XBM_TK_NUMBER
);
6731 if (LA1
== ',' || LA1
== '}')
6757 /* Load XBM image IMG which will be displayed on frame F from file
6758 SPECIFIED_FILE. Value is non-zero if successful. */
6761 xbm_load_image_from_file (f
, img
, specified_file
)
6764 Lisp_Object specified_file
;
6767 unsigned char *data
;
6770 struct gcpro gcpro1
;
6772 xassert (STRINGP (specified_file
));
6776 file
= x_find_image_file (specified_file
);
6777 if (!STRINGP (file
))
6779 image_error ("Cannot find image file %s", specified_file
, Qnil
);
6784 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6785 &img
->height
, &data
);
6788 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6789 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6790 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6793 xassert (img
->width
> 0 && img
->height
> 0);
6795 /* Get foreground and background colors, maybe allocate colors. */
6796 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6798 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6800 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6802 background
= x_alloc_image_color (f
, img
, value
, background
);
6806 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6809 img
->width
, img
->height
,
6810 foreground
, background
,
6814 if (img
->pixmap
== 0)
6816 x_clear_image (f
, img
);
6817 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6825 image_error ("Error loading XBM image %s", img
->spec
, Qnil
);
6832 /* Fill image IMG which is used on frame F with pixmap data. Value is
6833 non-zero if successful. */
6841 Lisp_Object file_name
;
6843 xassert (xbm_image_p (img
->spec
));
6845 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6846 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6847 if (STRINGP (file_name
))
6848 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6851 struct image_keyword fmt
[XBM_LAST
];
6854 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6855 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6859 /* Parse the list specification. */
6860 bcopy (xbm_format
, fmt
, sizeof fmt
);
6861 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
, 0);
6864 /* Get specified width, and height. */
6865 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6866 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6867 xassert (img
->width
> 0 && img
->height
> 0);
6871 if (fmt
[XBM_ASCENT
].count
)
6872 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6874 /* Get foreground and background colors, maybe allocate colors. */
6875 if (fmt
[XBM_FOREGROUND
].count
)
6876 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6878 if (fmt
[XBM_BACKGROUND
].count
)
6879 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6882 /* Set bits to the bitmap image data. */
6883 data
= fmt
[XBM_DATA
].value
;
6888 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6890 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6891 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6893 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6895 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6897 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6900 else if (STRINGP (data
))
6901 bits
= XSTRING (data
)->data
;
6903 bits
= XBOOL_VECTOR (data
)->data
;
6905 /* Create the pixmap. */
6906 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6908 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6911 img
->width
, img
->height
,
6912 foreground
, background
,
6918 image_error ("Unable to create pixmap for XBM image", Qnil
, Qnil
);
6919 x_clear_image (f
, img
);
6930 /***********************************************************************
6932 ***********************************************************************/
6936 static int xpm_image_p
P_ ((Lisp_Object object
));
6937 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6938 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6940 #include "X11/xpm.h"
6942 /* The symbol `xpm' identifying XPM-format images. */
6946 /* Indices of image specification fields in xpm_format, below. */
6948 enum xpm_keyword_index
6962 /* Vector of image_keyword structures describing the format
6963 of valid XPM image specifications. */
6965 static struct image_keyword xpm_format
[XPM_LAST
] =
6967 {":type", IMAGE_SYMBOL_VALUE
, 1},
6968 {":file", IMAGE_STRING_VALUE
, 0},
6969 {":data", IMAGE_STRING_VALUE
, 0},
6970 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6971 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6972 {":relief", IMAGE_INTEGER_VALUE
, 0},
6973 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6974 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6975 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6978 /* Structure describing the image type XBM. */
6980 static struct image_type xpm_type
=
6990 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6991 for XPM images. Such a list must consist of conses whose car and
6995 xpm_valid_color_symbols_p (color_symbols
)
6996 Lisp_Object color_symbols
;
6998 while (CONSP (color_symbols
))
7000 Lisp_Object sym
= XCAR (color_symbols
);
7002 || !STRINGP (XCAR (sym
))
7003 || !STRINGP (XCDR (sym
)))
7005 color_symbols
= XCDR (color_symbols
);
7008 return NILP (color_symbols
);
7012 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7015 xpm_image_p (object
)
7018 struct image_keyword fmt
[XPM_LAST
];
7019 bcopy (xpm_format
, fmt
, sizeof fmt
);
7020 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
, 0)
7021 /* Either `:file' or `:data' must be present. */
7022 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7023 /* Either no `:color-symbols' or it's a list of conses
7024 whose car and cdr are strings. */
7025 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7026 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
7027 && (fmt
[XPM_ASCENT
].count
== 0
7028 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
7032 /* Load image IMG which will be displayed on frame F. Value is
7033 non-zero if successful. */
7041 XpmAttributes attrs
;
7042 Lisp_Object specified_file
, color_symbols
;
7044 /* Configure the XPM lib. Use the visual of frame F. Allocate
7045 close colors. Return colors allocated. */
7046 bzero (&attrs
, sizeof attrs
);
7047 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7048 attrs
.valuemask
|= XpmVisual
;
7049 attrs
.valuemask
|= XpmReturnAllocPixels
;
7050 #ifdef XpmAllocCloseColors
7051 attrs
.alloc_close_colors
= 1;
7052 attrs
.valuemask
|= XpmAllocCloseColors
;
7054 attrs
.closeness
= 600;
7055 attrs
.valuemask
|= XpmCloseness
;
7058 /* If image specification contains symbolic color definitions, add
7059 these to `attrs'. */
7060 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7061 if (CONSP (color_symbols
))
7064 XpmColorSymbol
*xpm_syms
;
7067 attrs
.valuemask
|= XpmColorSymbols
;
7069 /* Count number of symbols. */
7070 attrs
.numsymbols
= 0;
7071 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7074 /* Allocate an XpmColorSymbol array. */
7075 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7076 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7077 bzero (xpm_syms
, size
);
7078 attrs
.colorsymbols
= xpm_syms
;
7080 /* Fill the color symbol array. */
7081 for (tail
= color_symbols
, i
= 0;
7083 ++i
, tail
= XCDR (tail
))
7085 Lisp_Object name
= XCAR (XCAR (tail
));
7086 Lisp_Object color
= XCDR (XCAR (tail
));
7087 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7088 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7089 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7090 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7094 /* Create a pixmap for the image, either from a file, or from a
7095 string buffer containing data in the same format as an XPM file. */
7097 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7098 if (STRINGP (specified_file
))
7100 Lisp_Object file
= x_find_image_file (specified_file
);
7101 if (!STRINGP (file
))
7103 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7107 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7108 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7113 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7114 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7115 XSTRING (buffer
)->data
,
7116 &img
->pixmap
, &img
->mask
,
7121 if (rc
== XpmSuccess
)
7123 /* Remember allocated colors. */
7124 img
->ncolors
= attrs
.nalloc_pixels
;
7125 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7126 * sizeof *img
->colors
);
7127 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7128 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7130 img
->width
= attrs
.width
;
7131 img
->height
= attrs
.height
;
7132 xassert (img
->width
> 0 && img
->height
> 0);
7134 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7136 XpmFreeAttributes (&attrs
);
7144 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7147 case XpmFileInvalid
:
7148 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7152 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7155 case XpmColorFailed
:
7156 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7160 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7165 return rc
== XpmSuccess
;
7168 #endif /* HAVE_XPM != 0 */
7171 /***********************************************************************
7173 ***********************************************************************/
7175 /* An entry in the color table mapping an RGB color to a pixel color. */
7180 unsigned long pixel
;
7182 /* Next in color table collision list. */
7183 struct ct_color
*next
;
7186 /* The bucket vector size to use. Must be prime. */
7190 /* Value is a hash of the RGB color given by R, G, and B. */
7192 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7194 /* The color hash table. */
7196 struct ct_color
**ct_table
;
7198 /* Number of entries in the color table. */
7200 int ct_colors_allocated
;
7202 /* Function prototypes. */
7204 static void init_color_table
P_ ((void));
7205 static void free_color_table
P_ ((void));
7206 static unsigned long *colors_in_color_table
P_ ((int *n
));
7207 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7208 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7211 /* Initialize the color table. */
7216 int size
= CT_SIZE
* sizeof (*ct_table
);
7217 ct_table
= (struct ct_color
**) xmalloc (size
);
7218 bzero (ct_table
, size
);
7219 ct_colors_allocated
= 0;
7223 /* Free memory associated with the color table. */
7229 struct ct_color
*p
, *next
;
7231 for (i
= 0; i
< CT_SIZE
; ++i
)
7232 for (p
= ct_table
[i
]; p
; p
= next
)
7243 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7244 entry for that color already is in the color table, return the
7245 pixel color of that entry. Otherwise, allocate a new color for R,
7246 G, B, and make an entry in the color table. */
7248 static unsigned long
7249 lookup_rgb_color (f
, r
, g
, b
)
7253 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7254 int i
= hash
% CT_SIZE
;
7257 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7258 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7272 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7273 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7278 ++ct_colors_allocated
;
7280 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7284 p
->pixel
= color
.pixel
;
7285 p
->next
= ct_table
[i
];
7289 return FRAME_FOREGROUND_PIXEL (f
);
7296 /* Look up pixel color PIXEL which is used on frame F in the color
7297 table. If not already present, allocate it. Value is PIXEL. */
7299 static unsigned long
7300 lookup_pixel_color (f
, pixel
)
7302 unsigned long pixel
;
7304 int i
= pixel
% CT_SIZE
;
7307 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7308 if (p
->pixel
== pixel
)
7319 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7320 color
.pixel
= pixel
;
7321 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7322 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7327 ++ct_colors_allocated
;
7329 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7334 p
->next
= ct_table
[i
];
7338 return FRAME_FOREGROUND_PIXEL (f
);
7345 /* Value is a vector of all pixel colors contained in the color table,
7346 allocated via xmalloc. Set *N to the number of colors. */
7348 static unsigned long *
7349 colors_in_color_table (n
)
7354 unsigned long *colors
;
7356 if (ct_colors_allocated
== 0)
7363 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7365 *n
= ct_colors_allocated
;
7367 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7368 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7369 colors
[j
++] = p
->pixel
;
7377 /***********************************************************************
7379 ***********************************************************************/
7381 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7382 int, XImage
*, int));
7383 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7384 XColor
*, int, XImage
*, int));
7387 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7388 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7389 the width of one row in the image. */
7392 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7402 for (x
= 0; x
< width
; ++x
)
7403 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7405 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7409 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7410 containing the pixel colors to write. F is the frame we are
7414 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7423 for (x
= 0; x
< width
; ++x
)
7424 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7428 /* Transform image IMG which is used on frame F with a Laplace
7429 edge-detection algorithm. The result is an image that can be used
7430 to draw disabled buttons, for example. */
7437 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7438 XImage
*ximg
, *oimg
;
7444 int in_y
, out_y
, rc
;
7449 /* Get the X image IMG->pixmap. */
7450 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7451 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7453 /* Allocate 3 input rows, and one output row of colors. */
7454 for (i
= 0; i
< 3; ++i
)
7455 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7456 out
= (long *) alloca (img
->width
* sizeof (long));
7458 /* Create an X image for output. */
7459 rc
= x_create_x_image_and_pixmap (f
, Qnil
, img
->width
, img
->height
, 0,
7462 /* Fill first two rows. */
7463 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7464 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7467 /* Write first row, all zeros. */
7468 init_color_table ();
7469 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7470 for (x
= 0; x
< img
->width
; ++x
)
7472 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7475 for (y
= 2; y
< img
->height
; ++y
)
7478 int rowb
= (y
+ 2) % 3;
7480 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7482 for (x
= 0; x
< img
->width
- 2; ++x
)
7484 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7485 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7486 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7488 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7492 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7495 /* Write last line, all zeros. */
7496 for (x
= 0; x
< img
->width
; ++x
)
7498 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7500 /* Free the input image, and free resources of IMG. */
7501 XDestroyImage (ximg
);
7502 x_clear_image (f
, img
);
7504 /* Put the output image into pixmap, and destroy it. */
7505 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7506 x_destroy_x_image (oimg
);
7508 /* Remember new pixmap and colors in IMG. */
7509 img
->pixmap
= pixmap
;
7510 img
->colors
= colors_in_color_table (&img
->ncolors
);
7511 free_color_table ();
7517 /* Build a mask for image IMG which is used on frame F. FILE is the
7518 name of an image file, for error messages. HOW determines how to
7519 determine the background color of IMG. If it is an integer, take
7520 that as the pixel value of the background. Otherwise, determine
7521 the background color of IMG heuristically. Value is non-zero
7525 x_build_heuristic_mask (f
, file
, img
, how
)
7531 Display
*dpy
= FRAME_X_DISPLAY (f
);
7532 Window win
= FRAME_X_WINDOW (f
);
7533 XImage
*ximg
, *mask_img
;
7539 /* Create an image and pixmap serving as mask. */
7540 rc
= x_create_x_image_and_pixmap (f
, file
, img
->width
, img
->height
, 1,
7541 &mask_img
, &img
->mask
);
7548 /* Get the X image of IMG->pixmap. */
7549 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7552 /* Determine the background color of ximg. If HOW is an integer,
7553 take that as a pixel color. Otherwise, try to determine the
7554 color heuristically. */
7556 bg
= XFASTINT (how
);
7559 unsigned long corners
[4];
7562 /* Get the colors at the corners of ximg. */
7563 corners
[0] = XGetPixel (ximg
, 0, 0);
7564 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7565 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7566 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7568 /* Choose the most frequently found color as background. */
7569 for (i
= best_count
= 0; i
< 4; ++i
)
7573 for (j
= n
= 0; j
< 4; ++j
)
7574 if (corners
[i
] == corners
[j
])
7578 bg
= corners
[i
], best_count
= n
;
7582 /* Set all bits in mask_img to 1 whose color in ximg is different
7583 from the background color bg. */
7584 for (y
= 0; y
< img
->height
; ++y
)
7585 for (x
= 0; x
< img
->width
; ++x
)
7586 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7588 /* Put mask_img into img->mask. */
7589 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7590 x_destroy_x_image (mask_img
);
7591 XDestroyImage (ximg
);
7599 /***********************************************************************
7600 PBM (mono, gray, color)
7601 ***********************************************************************/
7603 static int pbm_image_p
P_ ((Lisp_Object object
));
7604 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7605 static int pbm_scan_number
P_ ((FILE *fp
));
7607 /* The symbol `pbm' identifying images of this type. */
7611 /* Indices of image specification fields in gs_format, below. */
7613 enum pbm_keyword_index
7625 /* Vector of image_keyword structures describing the format
7626 of valid user-defined image specifications. */
7628 static struct image_keyword pbm_format
[PBM_LAST
] =
7630 {":type", IMAGE_SYMBOL_VALUE
, 1},
7631 {":file", IMAGE_STRING_VALUE
, 1},
7632 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7633 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7634 {":relief", IMAGE_INTEGER_VALUE
, 0},
7635 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7636 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7639 /* Structure describing the image type `pbm'. */
7641 static struct image_type pbm_type
=
7651 /* Return non-zero if OBJECT is a valid PBM image specification. */
7654 pbm_image_p (object
)
7657 struct image_keyword fmt
[PBM_LAST
];
7659 bcopy (pbm_format
, fmt
, sizeof fmt
);
7661 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
, 0)
7662 || (fmt
[PBM_ASCENT
].count
7663 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7669 /* Scan a decimal number from PBM input file FP and return it. Value
7670 is -1 at end of file or if an error occurs. */
7673 pbm_scan_number (fp
)
7680 /* Skip white-space. */
7681 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
7686 /* Skip comment to end of line. */
7687 while ((c
= fgetc (fp
)) != EOF
&& c
!= '\n')
7690 else if (isdigit (c
))
7692 /* Read decimal number. */
7694 while ((c
= fgetc (fp
)) != EOF
&& isdigit (c
))
7695 val
= 10 * val
+ c
- '0';
7706 /* Load PBM image IMG for use on frame F. */
7716 int width
, height
, max_color_idx
= 0, value
;
7718 Lisp_Object file
, specified_file
;
7719 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7720 struct gcpro gcpro1
;
7722 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7723 file
= x_find_image_file (specified_file
);
7725 if (!STRINGP (file
))
7727 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7732 fp
= fopen (XSTRING (file
)->data
, "r");
7739 /* Read first two characters. */
7740 if (fread (magic
, sizeof *magic
, 2, fp
) != 2)
7743 image_error ("Not a PBM image file: %s", file
, Qnil
);
7751 image_error ("Not a PBM image file: %s", file
, Qnil
);
7759 raw_p
= 0, type
= PBM_MONO
;
7763 raw_p
= 0, type
= PBM_GRAY
;
7767 raw_p
= 0, type
= PBM_COLOR
;
7771 raw_p
= 1, type
= PBM_MONO
;
7775 raw_p
= 1, type
= PBM_GRAY
;
7779 raw_p
= 1, type
= PBM_COLOR
;
7784 image_error ("Not a PBM image file: %s", file
, Qnil
);
7789 /* Read width, height, maximum color-component. Characters
7790 starting with `#' up to the end of a line are ignored. */
7791 width
= pbm_scan_number (fp
);
7792 height
= pbm_scan_number (fp
);
7794 if (type
!= PBM_MONO
)
7796 max_color_idx
= pbm_scan_number (fp
);
7797 if (raw_p
&& max_color_idx
> 255)
7798 max_color_idx
= 255;
7801 if (width
< 0 || height
< 0
7802 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7810 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0,
7811 &ximg
, &img
->pixmap
))
7819 /* Initialize the color hash table. */
7820 init_color_table ();
7822 if (type
== PBM_MONO
)
7826 for (y
= 0; y
< height
; ++y
)
7827 for (x
= 0; x
< width
; ++x
)
7837 g
= pbm_scan_number (fp
);
7839 XPutPixel (ximg
, x
, y
, (g
7840 ? FRAME_FOREGROUND_PIXEL (f
)
7841 : FRAME_BACKGROUND_PIXEL (f
)));
7846 for (y
= 0; y
< height
; ++y
)
7847 for (x
= 0; x
< width
; ++x
)
7851 if (type
== PBM_GRAY
)
7852 r
= g
= b
= raw_p
? fgetc (fp
) : pbm_scan_number (fp
);
7861 r
= pbm_scan_number (fp
);
7862 g
= pbm_scan_number (fp
);
7863 b
= pbm_scan_number (fp
);
7866 if (r
< 0 || g
< 0 || b
< 0)
7871 XDestroyImage (ximg
);
7873 image_error ("Invalid pixel value in file `%s'",
7879 /* RGB values are now in the range 0..max_color_idx.
7880 Scale this to the range 0..0xffff supported by X. */
7881 r
= (double) r
* 65535 / max_color_idx
;
7882 g
= (double) g
* 65535 / max_color_idx
;
7883 b
= (double) b
* 65535 / max_color_idx
;
7884 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7890 /* Store in IMG->colors the colors allocated for the image, and
7891 free the color table. */
7892 img
->colors
= colors_in_color_table (&img
->ncolors
);
7893 free_color_table ();
7895 /* Put the image into a pixmap. */
7896 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7897 x_destroy_x_image (ximg
);
7901 img
->height
= height
;
7909 /***********************************************************************
7911 ***********************************************************************/
7917 /* Function prototypes. */
7919 static int png_image_p
P_ ((Lisp_Object object
));
7920 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7922 /* The symbol `png' identifying images of this type. */
7926 /* Indices of image specification fields in png_format, below. */
7928 enum png_keyword_index
7940 /* Vector of image_keyword structures describing the format
7941 of valid user-defined image specifications. */
7943 static struct image_keyword png_format
[PNG_LAST
] =
7945 {":type", IMAGE_SYMBOL_VALUE
, 1},
7946 {":file", IMAGE_STRING_VALUE
, 1},
7947 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7948 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7949 {":relief", IMAGE_INTEGER_VALUE
, 0},
7950 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7951 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7954 /* Structure describing the image type `gif'. */
7956 static struct image_type png_type
=
7966 /* Return non-zero if OBJECT is a valid PNG image specification. */
7969 png_image_p (object
)
7972 struct image_keyword fmt
[PNG_LAST
];
7973 bcopy (png_format
, fmt
, sizeof fmt
);
7975 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
, 1)
7976 || (fmt
[PNG_ASCENT
].count
7977 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7983 /* Error and warning handlers installed when the PNG library
7987 my_png_error (png_ptr
, msg
)
7988 png_struct
*png_ptr
;
7991 xassert (png_ptr
!= NULL
);
7992 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7993 longjmp (png_ptr
->jmpbuf
, 1);
7998 my_png_warning (png_ptr
, msg
)
7999 png_struct
*png_ptr
;
8002 xassert (png_ptr
!= NULL
);
8003 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8007 /* Load PNG image IMG for use on frame F. Value is non-zero if
8015 Lisp_Object file
, specified_file
;
8017 XImage
*ximg
, *mask_img
= NULL
;
8018 struct gcpro gcpro1
;
8019 png_struct
*png_ptr
= NULL
;
8020 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8023 png_byte
*pixels
= NULL
;
8024 png_byte
**rows
= NULL
;
8025 png_uint_32 width
, height
;
8026 int bit_depth
, color_type
, interlace_type
;
8028 png_uint_32 row_bytes
;
8031 double screen_gamma
, image_gamma
;
8034 /* Find out what file to load. */
8035 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8036 file
= x_find_image_file (specified_file
);
8038 if (!STRINGP (file
))
8040 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8045 /* Open the image file. */
8046 fp
= fopen (XSTRING (file
)->data
, "rb");
8049 image_error ("Cannot open image file %s", file
, Qnil
);
8055 /* Check PNG signature. */
8056 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8057 || !png_check_sig (sig
, sizeof sig
))
8059 image_error ("Not a PNG file: %s", file
, Qnil
);
8065 /* Initialize read and info structs for PNG lib. */
8066 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8067 my_png_error
, my_png_warning
);
8075 info_ptr
= png_create_info_struct (png_ptr
);
8078 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8084 end_info
= png_create_info_struct (png_ptr
);
8087 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8093 /* Set error jump-back. We come back here when the PNG library
8094 detects an error. */
8095 if (setjmp (png_ptr
->jmpbuf
))
8099 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8108 /* Read image info. */
8109 png_init_io (png_ptr
, fp
);
8110 png_set_sig_bytes (png_ptr
, sizeof sig
);
8111 png_read_info (png_ptr
, info_ptr
);
8112 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8113 &interlace_type
, NULL
, NULL
);
8115 /* If image contains simply transparency data, we prefer to
8116 construct a clipping mask. */
8117 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8122 /* This function is easier to write if we only have to handle
8123 one data format: RGB or RGBA with 8 bits per channel. Let's
8124 transform other formats into that format. */
8126 /* Strip more than 8 bits per channel. */
8127 if (bit_depth
== 16)
8128 png_set_strip_16 (png_ptr
);
8130 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8132 png_set_expand (png_ptr
);
8134 /* Convert grayscale images to RGB. */
8135 if (color_type
== PNG_COLOR_TYPE_GRAY
8136 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8137 png_set_gray_to_rgb (png_ptr
);
8139 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8140 gamma_str
= getenv ("SCREEN_GAMMA");
8141 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8143 /* Tell the PNG lib to handle gamma correction for us. */
8145 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8146 /* There is a special chunk in the image specifying the gamma. */
8147 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8148 else if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8149 /* Image contains gamma information. */
8150 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8152 /* Use a default of 0.5 for the image gamma. */
8153 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8155 /* Handle alpha channel by combining the image with a background
8156 color. Do this only if a real alpha channel is supplied. For
8157 simple transparency, we prefer a clipping mask. */
8160 png_color_16
*image_background
;
8162 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8163 /* Image contains a background color with which to
8164 combine the image. */
8165 png_set_background (png_ptr
, image_background
,
8166 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8169 /* Image does not contain a background color with which
8170 to combine the image data via an alpha channel. Use
8171 the frame's background instead. */
8174 png_color_16 frame_background
;
8177 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8178 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8179 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8182 bzero (&frame_background
, sizeof frame_background
);
8183 frame_background
.red
= color
.red
;
8184 frame_background
.green
= color
.green
;
8185 frame_background
.blue
= color
.blue
;
8187 png_set_background (png_ptr
, &frame_background
,
8188 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8192 /* Update info structure. */
8193 png_read_update_info (png_ptr
, info_ptr
);
8195 /* Get number of channels. Valid values are 1 for grayscale images
8196 and images with a palette, 2 for grayscale images with transparency
8197 information (alpha channel), 3 for RGB images, and 4 for RGB
8198 images with alpha channel, i.e. RGBA. If conversions above were
8199 sufficient we should only have 3 or 4 channels here. */
8200 channels
= png_get_channels (png_ptr
, info_ptr
);
8201 xassert (channels
== 3 || channels
== 4);
8203 /* Number of bytes needed for one row of the image. */
8204 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8206 /* Allocate memory for the image. */
8207 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8208 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8209 for (i
= 0; i
< height
; ++i
)
8210 rows
[i
] = pixels
+ i
* row_bytes
;
8212 /* Read the entire image. */
8213 png_read_image (png_ptr
, rows
);
8214 png_read_end (png_ptr
, info_ptr
);
8220 /* Create the X image and pixmap. */
8221 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8228 /* Create an image and pixmap serving as mask if the PNG image
8229 contains an alpha channel. */
8232 && !x_create_x_image_and_pixmap (f
, file
, width
, height
, 1,
8233 &mask_img
, &img
->mask
))
8235 x_destroy_x_image (ximg
);
8236 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8242 /* Fill the X image and mask from PNG data. */
8243 init_color_table ();
8245 for (y
= 0; y
< height
; ++y
)
8247 png_byte
*p
= rows
[y
];
8249 for (x
= 0; x
< width
; ++x
)
8256 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8258 /* An alpha channel, aka mask channel, associates variable
8259 transparency with an image. Where other image formats
8260 support binary transparency---fully transparent or fully
8261 opaque---PNG allows up to 254 levels of partial transparency.
8262 The PNG library implements partial transparency by combining
8263 the image with a specified background color.
8265 I'm not sure how to handle this here nicely: because the
8266 background on which the image is displayed may change, for
8267 real alpha channel support, it would be necessary to create
8268 a new image for each possible background.
8270 What I'm doing now is that a mask is created if we have
8271 boolean transparency information. Otherwise I'm using
8272 the frame's background color to combine the image with. */
8277 XPutPixel (mask_img
, x
, y
, *p
> 0);
8283 /* Remember colors allocated for this image. */
8284 img
->colors
= colors_in_color_table (&img
->ncolors
);
8285 free_color_table ();
8288 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8293 img
->height
= height
;
8295 /* Put the image into the pixmap, then free the X image and its buffer. */
8296 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8297 x_destroy_x_image (ximg
);
8299 /* Same for the mask. */
8302 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8303 x_destroy_x_image (mask_img
);
8311 #endif /* HAVE_PNG != 0 */
8315 /***********************************************************************
8317 ***********************************************************************/
8321 /* Work around a warning about HAVE_STDLIB_H being redefined in
8323 #ifdef HAVE_STDLIB_H
8324 #define HAVE_STDLIB_H_1
8325 #undef HAVE_STDLIB_H
8326 #endif /* HAVE_STLIB_H */
8328 #include <jpeglib.h>
8332 #ifdef HAVE_STLIB_H_1
8333 #define HAVE_STDLIB_H 1
8336 static int jpeg_image_p
P_ ((Lisp_Object object
));
8337 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8339 /* The symbol `jpeg' identifying images of this type. */
8343 /* Indices of image specification fields in gs_format, below. */
8345 enum jpeg_keyword_index
8353 JPEG_HEURISTIC_MASK
,
8357 /* Vector of image_keyword structures describing the format
8358 of valid user-defined image specifications. */
8360 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8362 {":type", IMAGE_SYMBOL_VALUE
, 1},
8363 {":file", IMAGE_STRING_VALUE
, 1},
8364 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8365 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8366 {":relief", IMAGE_INTEGER_VALUE
, 0},
8367 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8368 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8371 /* Structure describing the image type `jpeg'. */
8373 static struct image_type jpeg_type
=
8383 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8386 jpeg_image_p (object
)
8389 struct image_keyword fmt
[JPEG_LAST
];
8391 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8393 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
, 0)
8394 || (fmt
[JPEG_ASCENT
].count
8395 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8400 struct my_jpeg_error_mgr
8402 struct jpeg_error_mgr pub
;
8403 jmp_buf setjmp_buffer
;
8407 my_error_exit (cinfo
)
8410 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8411 longjmp (mgr
->setjmp_buffer
, 1);
8414 /* Load image IMG for use on frame F. Patterned after example.c
8415 from the JPEG lib. */
8422 struct jpeg_decompress_struct cinfo
;
8423 struct my_jpeg_error_mgr mgr
;
8424 Lisp_Object file
, specified_file
;
8427 int row_stride
, x
, y
;
8428 XImage
*ximg
= NULL
;
8430 unsigned long *colors
;
8432 struct gcpro gcpro1
;
8434 /* Open the JPEG file. */
8435 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8436 file
= x_find_image_file (specified_file
);
8438 if (!STRINGP (file
))
8440 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8445 fp
= fopen (XSTRING (file
)->data
, "r");
8448 image_error ("Cannot open `%s'", file
, Qnil
);
8453 /* Customize libjpeg's error handling to call my_error_exit
8454 when an error is detected. This function will perform
8456 mgr
.pub
.error_exit
= my_error_exit
;
8457 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8459 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8463 /* Called from my_error_exit. Display a JPEG error. */
8464 char buffer
[JMSG_LENGTH_MAX
];
8465 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8466 image_error ("Error reading JPEG file `%s': %s", file
,
8467 build_string (buffer
));
8470 /* Close the input file and destroy the JPEG object. */
8472 jpeg_destroy_decompress (&cinfo
);
8476 /* If we already have an XImage, free that. */
8477 x_destroy_x_image (ximg
);
8479 /* Free pixmap and colors. */
8480 x_clear_image (f
, img
);
8487 /* Create the JPEG decompression object. Let it read from fp.
8488 Read the JPEG image header. */
8489 jpeg_create_decompress (&cinfo
);
8490 jpeg_stdio_src (&cinfo
, fp
);
8491 jpeg_read_header (&cinfo
, TRUE
);
8493 /* Customize decompression so that color quantization will be used.
8494 Start decompression. */
8495 cinfo
.quantize_colors
= TRUE
;
8496 jpeg_start_decompress (&cinfo
);
8497 width
= img
->width
= cinfo
.output_width
;
8498 height
= img
->height
= cinfo
.output_height
;
8502 /* Create X image and pixmap. */
8503 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8507 longjmp (mgr
.setjmp_buffer
, 2);
8510 /* Allocate colors. When color quantization is used,
8511 cinfo.actual_number_of_colors has been set with the number of
8512 colors generated, and cinfo.colormap is a two-dimensional array
8513 of color indices in the range 0..cinfo.actual_number_of_colors.
8514 No more than 255 colors will be generated. */
8518 if (cinfo
.out_color_components
> 2)
8519 ir
= 0, ig
= 1, ib
= 2;
8520 else if (cinfo
.out_color_components
> 1)
8521 ir
= 0, ig
= 1, ib
= 0;
8523 ir
= 0, ig
= 0, ib
= 0;
8525 /* Use the color table mechanism because it handles colors that
8526 cannot be allocated nicely. Such colors will be replaced with
8527 a default color, and we don't have to care about which colors
8528 can be freed safely, and which can't. */
8529 init_color_table ();
8530 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8533 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8535 /* Multiply RGB values with 255 because X expects RGB values
8536 in the range 0..0xffff. */
8537 int r
= cinfo
.colormap
[ir
][i
] << 8;
8538 int g
= cinfo
.colormap
[ig
][i
] << 8;
8539 int b
= cinfo
.colormap
[ib
][i
] << 8;
8540 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8543 /* Remember those colors actually allocated. */
8544 img
->colors
= colors_in_color_table (&img
->ncolors
);
8545 free_color_table ();
8549 row_stride
= width
* cinfo
.output_components
;
8550 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8552 for (y
= 0; y
< height
; ++y
)
8554 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8555 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8556 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8560 jpeg_finish_decompress (&cinfo
);
8561 jpeg_destroy_decompress (&cinfo
);
8564 /* Put the image into the pixmap. */
8565 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8566 x_destroy_x_image (ximg
);
8572 #endif /* HAVE_JPEG */
8576 /***********************************************************************
8578 ***********************************************************************/
8584 static int tiff_image_p
P_ ((Lisp_Object object
));
8585 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8587 /* The symbol `tiff' identifying images of this type. */
8591 /* Indices of image specification fields in tiff_format, below. */
8593 enum tiff_keyword_index
8601 TIFF_HEURISTIC_MASK
,
8605 /* Vector of image_keyword structures describing the format
8606 of valid user-defined image specifications. */
8608 static struct image_keyword tiff_format
[TIFF_LAST
] =
8610 {":type", IMAGE_SYMBOL_VALUE
, 1},
8611 {":file", IMAGE_STRING_VALUE
, 1},
8612 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8613 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8614 {":relief", IMAGE_INTEGER_VALUE
, 0},
8615 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8616 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8619 /* Structure describing the image type `tiff'. */
8621 static struct image_type tiff_type
=
8631 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8634 tiff_image_p (object
)
8637 struct image_keyword fmt
[TIFF_LAST
];
8638 bcopy (tiff_format
, fmt
, sizeof fmt
);
8640 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
, 1)
8641 || (fmt
[TIFF_ASCENT
].count
8642 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8648 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8656 Lisp_Object file
, specified_file
;
8658 int width
, height
, x
, y
;
8662 struct gcpro gcpro1
;
8664 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8665 file
= x_find_image_file (specified_file
);
8667 if (!STRINGP (file
))
8669 image_error ("Cannot find image file %s", file
, Qnil
);
8674 /* Try to open the image file. */
8675 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8678 image_error ("Cannot open `%s'", file
, Qnil
);
8683 /* Get width and height of the image, and allocate a raster buffer
8684 of width x height 32-bit values. */
8685 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8686 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8687 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8689 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8693 image_error ("Error reading `%s'", file
, Qnil
);
8701 /* Create the X image and pixmap. */
8702 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8711 /* Initialize the color table. */
8712 init_color_table ();
8714 /* Process the pixel raster. Origin is in the lower-left corner. */
8715 for (y
= 0; y
< height
; ++y
)
8717 uint32
*row
= buf
+ y
* width
;
8719 for (x
= 0; x
< width
; ++x
)
8721 uint32 abgr
= row
[x
];
8722 int r
= TIFFGetR (abgr
) << 8;
8723 int g
= TIFFGetG (abgr
) << 8;
8724 int b
= TIFFGetB (abgr
) << 8;
8725 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8729 /* Remember the colors allocated for the image. Free the color table. */
8730 img
->colors
= colors_in_color_table (&img
->ncolors
);
8731 free_color_table ();
8733 /* Put the image into the pixmap, then free the X image and its buffer. */
8734 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8735 x_destroy_x_image (ximg
);
8740 img
->height
= height
;
8746 #endif /* HAVE_TIFF != 0 */
8750 /***********************************************************************
8752 ***********************************************************************/
8756 #include <gif_lib.h>
8758 static int gif_image_p
P_ ((Lisp_Object object
));
8759 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8761 /* The symbol `gif' identifying images of this type. */
8765 /* Indices of image specification fields in gif_format, below. */
8767 enum gif_keyword_index
8780 /* Vector of image_keyword structures describing the format
8781 of valid user-defined image specifications. */
8783 static struct image_keyword gif_format
[GIF_LAST
] =
8785 {":type", IMAGE_SYMBOL_VALUE
, 1},
8786 {":file", IMAGE_STRING_VALUE
, 1},
8787 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8788 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8789 {":relief", IMAGE_INTEGER_VALUE
, 0},
8790 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8791 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8792 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8795 /* Structure describing the image type `gif'. */
8797 static struct image_type gif_type
=
8807 /* Return non-zero if OBJECT is a valid GIF image specification. */
8810 gif_image_p (object
)
8813 struct image_keyword fmt
[GIF_LAST
];
8814 bcopy (gif_format
, fmt
, sizeof fmt
);
8816 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
, 1)
8817 || (fmt
[GIF_ASCENT
].count
8818 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8824 /* Load GIF image IMG for use on frame F. Value is non-zero if
8832 Lisp_Object file
, specified_file
;
8833 int rc
, width
, height
, x
, y
, i
;
8835 ColorMapObject
*gif_color_map
;
8836 unsigned long pixel_colors
[256];
8838 struct gcpro gcpro1
;
8840 int ino
, image_left
, image_top
, image_width
, image_height
;
8843 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8844 file
= x_find_image_file (specified_file
);
8846 if (!STRINGP (file
))
8848 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8853 /* Open the GIF file. */
8854 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8857 image_error ("Cannot open `%s'", file
, Qnil
);
8862 /* Read entire contents. */
8863 rc
= DGifSlurp (gif
);
8864 if (rc
== GIF_ERROR
)
8866 image_error ("Error reading `%s'", file
, Qnil
);
8867 DGifCloseFile (gif
);
8872 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8873 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8874 if (ino
>= gif
->ImageCount
)
8876 image_error ("Invalid image number `%s'", image
, Qnil
);
8877 DGifCloseFile (gif
);
8882 width
= img
->width
= gif
->SWidth
;
8883 height
= img
->height
= gif
->SHeight
;
8887 /* Create the X image and pixmap. */
8888 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8892 DGifCloseFile (gif
);
8897 /* Allocate colors. */
8898 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8900 gif_color_map
= gif
->SColorMap
;
8901 init_color_table ();
8902 bzero (pixel_colors
, sizeof pixel_colors
);
8904 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8906 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8907 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8908 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8909 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8912 img
->colors
= colors_in_color_table (&img
->ncolors
);
8913 free_color_table ();
8915 /* Clear the part of the screen image that are not covered by
8916 the image from the GIF file. Full animated GIF support
8917 requires more than can be done here (see the gif89 spec,
8918 disposal methods). Let's simply assume that the part
8919 not covered by a sub-image is in the frame's background color. */
8920 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8921 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8922 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8923 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8925 for (y
= 0; y
< image_top
; ++y
)
8926 for (x
= 0; x
< width
; ++x
)
8927 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8929 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8930 for (x
= 0; x
< width
; ++x
)
8931 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8933 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8935 for (x
= 0; x
< image_left
; ++x
)
8936 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8937 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8938 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8941 /* Read the GIF image into the X image. */
8942 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8944 static int interlace_start
[] = {0, 4, 2, 1};
8945 static int interlace_increment
[] = {8, 8, 4, 2};
8948 for (pass
= 0; pass
< 4; ++pass
)
8950 inc
= interlace_increment
[pass
];
8951 for (y
= interlace_start
[pass
]; y
< image_height
; y
+= inc
)
8952 for (x
= 0; x
< image_width
; ++x
)
8954 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8955 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
,
8962 for (y
= 0; y
< image_height
; ++y
)
8963 for (x
= 0; x
< image_width
; ++x
)
8965 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8966 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8970 DGifCloseFile (gif
);
8972 /* Put the image into the pixmap, then free the X image and its buffer. */
8973 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8974 x_destroy_x_image (ximg
);
8981 #endif /* HAVE_GIF != 0 */
8985 /***********************************************************************
8987 ***********************************************************************/
8989 static int gs_image_p
P_ ((Lisp_Object object
));
8990 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8991 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8993 /* The symbol `ghostscript' identifying images of this type. */
8995 Lisp_Object Qghostscript
;
8997 /* Keyword symbols. */
8999 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9001 /* Indices of image specification fields in gs_format, below. */
9003 enum gs_keyword_index
9019 /* Vector of image_keyword structures describing the format
9020 of valid user-defined image specifications. */
9022 static struct image_keyword gs_format
[GS_LAST
] =
9024 {":type", IMAGE_SYMBOL_VALUE
, 1},
9025 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9026 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9027 {":file", IMAGE_STRING_VALUE
, 1},
9028 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9029 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9030 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9031 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9032 {":relief", IMAGE_INTEGER_VALUE
, 0},
9033 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9034 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9037 /* Structure describing the image type `ghostscript'. */
9039 static struct image_type gs_type
=
9049 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9052 gs_clear_image (f
, img
)
9056 /* IMG->data.ptr_val may contain a recorded colormap. */
9057 xfree (img
->data
.ptr_val
);
9058 x_clear_image (f
, img
);
9062 /* Return non-zero if OBJECT is a valid Ghostscript image
9069 struct image_keyword fmt
[GS_LAST
];
9073 bcopy (gs_format
, fmt
, sizeof fmt
);
9075 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qghostscript
, 1)
9076 || (fmt
[GS_ASCENT
].count
9077 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9080 /* Bounding box must be a list or vector containing 4 integers. */
9081 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9084 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9085 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9090 else if (VECTORP (tem
))
9092 if (XVECTOR (tem
)->size
!= 4)
9094 for (i
= 0; i
< 4; ++i
)
9095 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9105 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9114 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9115 struct gcpro gcpro1
, gcpro2
;
9117 double in_width
, in_height
;
9118 Lisp_Object pixel_colors
= Qnil
;
9120 /* Compute pixel size of pixmap needed from the given size in the
9121 image specification. Sizes in the specification are in pt. 1 pt
9122 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9124 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9125 in_width
= XFASTINT (pt_width
) / 72.0;
9126 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9127 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9128 in_height
= XFASTINT (pt_height
) / 72.0;
9129 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9131 /* Create the pixmap. */
9133 xassert (img
->pixmap
== 0);
9134 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9135 img
->width
, img
->height
,
9136 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9141 image_error ("Unable to create pixmap for `%s'",
9142 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9146 /* Call the loader to fill the pixmap. It returns a process object
9147 if successful. We do not record_unwind_protect here because
9148 other places in redisplay like calling window scroll functions
9149 don't either. Let the Lisp loader use `unwind-protect' instead. */
9150 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9152 sprintf (buffer
, "%lu %lu",
9153 (unsigned long) FRAME_X_WINDOW (f
),
9154 (unsigned long) img
->pixmap
);
9155 window_and_pixmap_id
= build_string (buffer
);
9157 sprintf (buffer
, "%lu %lu",
9158 FRAME_FOREGROUND_PIXEL (f
),
9159 FRAME_BACKGROUND_PIXEL (f
));
9160 pixel_colors
= build_string (buffer
);
9162 XSETFRAME (frame
, f
);
9163 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9165 loader
= intern ("gs-load-image");
9167 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9168 make_number (img
->width
),
9169 make_number (img
->height
),
9170 window_and_pixmap_id
,
9173 return PROCESSP (img
->data
.lisp_val
);
9177 /* Kill the Ghostscript process that was started to fill PIXMAP on
9178 frame F. Called from XTread_socket when receiving an event
9179 telling Emacs that Ghostscript has finished drawing. */
9182 x_kill_gs_process (pixmap
, f
)
9186 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9190 /* Find the image containing PIXMAP. */
9191 for (i
= 0; i
< c
->used
; ++i
)
9192 if (c
->images
[i
]->pixmap
== pixmap
)
9195 /* Kill the GS process. We should have found PIXMAP in the image
9196 cache and its image should contain a process object. */
9197 xassert (i
< c
->used
);
9199 xassert (PROCESSP (img
->data
.lisp_val
));
9200 Fkill_process (img
->data
.lisp_val
, Qnil
);
9201 img
->data
.lisp_val
= Qnil
;
9203 /* On displays with a mutable colormap, figure out the colors
9204 allocated for the image by looking at the pixels of an XImage for
9206 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9207 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9213 /* Try to get an XImage for img->pixmep. */
9214 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9215 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9220 /* Initialize the color table. */
9221 init_color_table ();
9223 /* For each pixel of the image, look its color up in the
9224 color table. After having done so, the color table will
9225 contain an entry for each color used by the image. */
9226 for (y
= 0; y
< img
->height
; ++y
)
9227 for (x
= 0; x
< img
->width
; ++x
)
9229 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9230 lookup_pixel_color (f
, pixel
);
9233 /* Record colors in the image. Free color table and XImage. */
9234 img
->colors
= colors_in_color_table (&img
->ncolors
);
9235 free_color_table ();
9236 XDestroyImage (ximg
);
9238 #if 0 /* This doesn't seem to be the case. If we free the colors
9239 here, we get a BadAccess later in x_clear_image when
9240 freeing the colors. */
9241 /* We have allocated colors once, but Ghostscript has also
9242 allocated colors on behalf of us. So, to get the
9243 reference counts right, free them once. */
9246 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9247 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9248 img
->colors
, img
->ncolors
, 0);
9253 image_error ("Cannot get X image of `%s'; colors will not be freed",
9254 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9262 /***********************************************************************
9264 ***********************************************************************/
9266 DEFUN ("x-change-window-property", Fx_change_window_property
,
9267 Sx_change_window_property
, 2, 3, 0,
9268 "Change window property PROP to VALUE on the X window of FRAME.\n\
9269 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9270 selected frame. Value is VALUE.")
9271 (prop
, value
, frame
)
9272 Lisp_Object frame
, prop
, value
;
9274 struct frame
*f
= check_x_frame (frame
);
9277 CHECK_STRING (prop
, 1);
9278 CHECK_STRING (value
, 2);
9281 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9282 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9283 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9284 XSTRING (value
)->data
, XSTRING (value
)->size
);
9286 /* Make sure the property is set when we return. */
9287 XFlush (FRAME_X_DISPLAY (f
));
9294 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9295 Sx_delete_window_property
, 1, 2, 0,
9296 "Remove window property PROP from X window of FRAME.\n\
9297 FRAME nil or omitted means use the selected frame. Value is PROP.")
9299 Lisp_Object prop
, frame
;
9301 struct frame
*f
= check_x_frame (frame
);
9304 CHECK_STRING (prop
, 1);
9306 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9307 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9309 /* Make sure the property is removed when we return. */
9310 XFlush (FRAME_X_DISPLAY (f
));
9317 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9319 "Value is the value of window property PROP on FRAME.\n\
9320 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9321 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9324 Lisp_Object prop
, frame
;
9326 struct frame
*f
= check_x_frame (frame
);
9329 Lisp_Object prop_value
= Qnil
;
9330 char *tmp_data
= NULL
;
9333 unsigned long actual_size
, bytes_remaining
;
9335 CHECK_STRING (prop
, 1);
9337 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9338 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9339 prop_atom
, 0, 0, False
, XA_STRING
,
9340 &actual_type
, &actual_format
, &actual_size
,
9341 &bytes_remaining
, (unsigned char **) &tmp_data
);
9344 int size
= bytes_remaining
;
9349 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9350 prop_atom
, 0, bytes_remaining
,
9352 &actual_type
, &actual_format
,
9353 &actual_size
, &bytes_remaining
,
9354 (unsigned char **) &tmp_data
);
9356 prop_value
= make_string (tmp_data
, size
);
9367 /***********************************************************************
9369 ***********************************************************************/
9371 /* The implementation partly follows a patch from
9372 F.Pierresteguy@frcl.bull.fr dated 1994. */
9374 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9375 the next X event is read and we enter XTread_socket again. Setting
9376 it to 1 inhibits busy-cursor display for direct commands. */
9378 int inhibit_busy_cursor
;
9380 /* Incremented with each call to x-display-busy-cursor.
9381 Decremented in x-undisplay-busy-cursor. */
9383 static int busy_count
;
9386 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9387 Sx_show_busy_cursor
, 0, 0, 0,
9388 "Show a busy cursor, if not already shown.\n\
9389 Each call to this function must be matched by a call to\n\
9390 x-undisplay-busy-cursor to make the busy pointer disappear again.")
9394 if (busy_count
== 1)
9396 Lisp_Object rest
, frame
;
9398 FOR_EACH_FRAME (rest
, frame
)
9399 if (FRAME_X_P (XFRAME (frame
)))
9401 struct frame
*f
= XFRAME (frame
);
9404 f
->output_data
.x
->busy_p
= 1;
9406 if (!f
->output_data
.x
->busy_window
)
9408 unsigned long mask
= CWCursor
;
9409 XSetWindowAttributes attrs
;
9411 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9412 f
->output_data
.x
->busy_window
9413 = XCreateWindow (FRAME_X_DISPLAY (f
),
9414 FRAME_OUTER_WINDOW (f
),
9415 0, 0, 32000, 32000, 0, 0,
9416 InputOnly
, CopyFromParent
,
9420 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9429 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9430 Sx_hide_busy_cursor
, 0, 1, 0,
9431 "Hide a busy-cursor.\n\
9432 A busy-cursor will actually be undisplayed when a matching\n\
9433 `x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
9434 issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
9435 not counting calls.")
9439 Lisp_Object rest
, frame
;
9441 if (busy_count
== 0)
9444 if (!NILP (force
) && busy_count
!= 0)
9448 if (busy_count
!= 0)
9451 FOR_EACH_FRAME (rest
, frame
)
9453 struct frame
*f
= XFRAME (frame
);
9456 /* Watch out for newly created frames. */
9457 && f
->output_data
.x
->busy_window
)
9461 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9462 /* Sync here because XTread_socket looks at the busy_p flag
9463 that is reset to zero below. */
9464 XSync (FRAME_X_DISPLAY (f
), False
);
9466 f
->output_data
.x
->busy_p
= 0;
9475 /***********************************************************************
9477 ***********************************************************************/
9479 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9482 /* The frame of a currently visible tooltip, or null. */
9484 struct frame
*tip_frame
;
9486 /* If non-nil, a timer started that hides the last tooltip when it
9489 Lisp_Object tip_timer
;
9492 /* Create a frame for a tooltip on the display described by DPYINFO.
9493 PARMS is a list of frame parameters. Value is the frame. */
9496 x_create_tip_frame (dpyinfo
, parms
)
9497 struct x_display_info
*dpyinfo
;
9501 Lisp_Object frame
, tem
;
9503 int minibuffer_only
= 0;
9504 long window_prompting
= 0;
9506 int count
= specpdl_ptr
- specpdl
;
9507 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
9512 /* Use this general default value to start with until we know if
9513 this frame has a specified name. */
9514 Vx_resource_name
= Vinvocation_name
;
9517 kb
= dpyinfo
->kboard
;
9519 kb
= &the_only_kboard
;
9522 /* Get the name of the frame to use for resource lookup. */
9523 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9525 && !EQ (name
, Qunbound
)
9527 error ("Invalid frame name--not a string or nil");
9528 Vx_resource_name
= name
;
9531 GCPRO3 (parms
, name
, frame
);
9532 tip_frame
= f
= make_frame (1);
9533 XSETFRAME (frame
, f
);
9534 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9536 f
->output_method
= output_x_window
;
9537 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9538 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9539 f
->output_data
.x
->icon_bitmap
= -1;
9540 f
->output_data
.x
->fontset
= -1;
9541 f
->icon_name
= Qnil
;
9542 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9544 FRAME_KBOARD (f
) = kb
;
9546 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9547 f
->output_data
.x
->explicit_parent
= 0;
9549 /* Set the name; the functions to which we pass f expect the name to
9551 if (EQ (name
, Qunbound
) || NILP (name
))
9553 f
->name
= build_string (dpyinfo
->x_id_name
);
9554 f
->explicit_name
= 0;
9559 f
->explicit_name
= 1;
9560 /* use the frame's title when getting resources for this frame. */
9561 specbind (Qx_resource_name
, name
);
9564 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9565 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
9566 fs_register_fontset (f
, XCONS (tem
)->car
);
9568 /* Extract the window parameters from the supplied values
9569 that are needed to determine window geometry. */
9573 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9576 /* First, try whatever font the caller has specified. */
9579 tem
= Fquery_fontset (font
, Qnil
);
9581 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9583 font
= x_new_font (f
, XSTRING (font
)->data
);
9586 /* Try out a font which we hope has bold and italic variations. */
9587 if (!STRINGP (font
))
9588 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9589 if (!STRINGP (font
))
9590 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9591 if (! STRINGP (font
))
9592 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9593 if (! STRINGP (font
))
9594 /* This was formerly the first thing tried, but it finds too many fonts
9595 and takes too long. */
9596 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9597 /* If those didn't work, look for something which will at least work. */
9598 if (! STRINGP (font
))
9599 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9601 if (! STRINGP (font
))
9602 font
= build_string ("fixed");
9604 x_default_parameter (f
, parms
, Qfont
, font
,
9605 "font", "Font", RES_TYPE_STRING
);
9608 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9609 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9611 /* This defaults to 2 in order to match xterm. We recognize either
9612 internalBorderWidth or internalBorder (which is what xterm calls
9614 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9618 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9619 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9620 if (! EQ (value
, Qunbound
))
9621 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9625 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9626 "internalBorderWidth", "internalBorderWidth",
9629 /* Also do the stuff which must be set before the window exists. */
9630 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9631 "foreground", "Foreground", RES_TYPE_STRING
);
9632 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9633 "background", "Background", RES_TYPE_STRING
);
9634 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9635 "pointerColor", "Foreground", RES_TYPE_STRING
);
9636 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9637 "cursorColor", "Foreground", RES_TYPE_STRING
);
9638 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9639 "borderColor", "BorderColor", RES_TYPE_STRING
);
9641 /* Init faces before x_default_parameter is called for scroll-bar
9642 parameters because that function calls x_set_scroll_bar_width,
9643 which calls change_frame_size, which calls Fset_window_buffer,
9644 which runs hooks, which call Fvertical_motion. At the end, we
9645 end up in init_iterator with a null face cache, which should not
9647 init_frame_faces (f
);
9649 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9650 window_prompting
= x_figure_window_size (f
, parms
);
9652 if (window_prompting
& XNegative
)
9654 if (window_prompting
& YNegative
)
9655 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9657 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9661 if (window_prompting
& YNegative
)
9662 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9664 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9667 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9669 XSetWindowAttributes attrs
;
9673 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9674 /* Window managers looks at the override-redirect flag to
9675 determine whether or net to give windows a decoration (Xlib
9677 attrs
.override_redirect
= True
;
9678 attrs
.save_under
= True
;
9679 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9680 /* Arrange for getting MapNotify and UnmapNotify events. */
9681 attrs
.event_mask
= StructureNotifyMask
;
9683 = FRAME_X_WINDOW (f
)
9684 = XCreateWindow (FRAME_X_DISPLAY (f
),
9685 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9686 /* x, y, width, height */
9690 CopyFromParent
, InputOutput
, CopyFromParent
,
9697 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9698 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9699 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9700 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9701 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9702 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9704 /* Dimensions, especially f->height, must be done via change_frame_size.
9705 Change will not be effected unless different from the current
9710 SET_FRAME_WIDTH (f
, 0);
9711 change_frame_size (f
, height
, width
, 1, 0, 0);
9717 /* It is now ok to make the frame official even if we get an error
9718 below. And the frame needs to be on Vframe_list or making it
9719 visible won't work. */
9720 Vframe_list
= Fcons (frame
, Vframe_list
);
9722 /* Now that the frame is official, it counts as a reference to
9724 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9726 return unbind_to (count
, frame
);
9730 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9731 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9732 A tooltip window is a small X window displaying STRING at\n\
9733 the current mouse position.\n\
9734 FRAME nil or omitted means use the selected frame.\n\
9735 PARMS is an optional list of frame parameters which can be\n\
9736 used to change the tooltip's appearance.\n\
9737 Automatically hide the tooltip after TIMEOUT seconds.\n\
9738 TIMEOUT nil means use the default timeout of 5 seconds.")
9739 (string
, frame
, parms
, timeout
)
9740 Lisp_Object string
, frame
, parms
;
9747 struct buffer
*old_buffer
;
9748 struct text_pos pos
;
9749 int i
, width
, height
;
9750 int root_x
, root_y
, win_x
, win_y
;
9752 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9753 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9754 int count
= specpdl_ptr
- specpdl
;
9756 specbind (Qinhibit_redisplay
, Qt
);
9758 GCPRO3 (string
, parms
, frame
);
9760 CHECK_STRING (string
, 0);
9761 f
= check_x_frame (frame
);
9763 timeout
= make_number (5);
9765 CHECK_NATNUM (timeout
, 2);
9767 /* Hide a previous tip, if any. */
9770 /* Add default values to frame parameters. */
9771 if (NILP (Fassq (Qname
, parms
)))
9772 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9773 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9774 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9775 if (NILP (Fassq (Qborder_width
, parms
)))
9776 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9777 if (NILP (Fassq (Qborder_color
, parms
)))
9778 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9779 if (NILP (Fassq (Qbackground_color
, parms
)))
9780 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9783 /* Create a frame for the tooltip, and record it in the global
9784 variable tip_frame. */
9785 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9786 tip_frame
= f
= XFRAME (frame
);
9788 /* Set up the frame's root window. Currently we use a size of 80
9789 columns x 40 lines. If someone wants to show a larger tip, he
9790 will loose. I don't think this is a realistic case. */
9791 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9792 w
->left
= w
->top
= make_number (0);
9796 w
->pseudo_window_p
= 1;
9798 /* Display the tooltip text in a temporary buffer. */
9799 buffer
= Fget_buffer_create (build_string (" *tip*"));
9800 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9801 old_buffer
= current_buffer
;
9802 set_buffer_internal_1 (XBUFFER (buffer
));
9804 Finsert (make_number (1), &string
);
9805 clear_glyph_matrix (w
->desired_matrix
);
9806 clear_glyph_matrix (w
->current_matrix
);
9807 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9808 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9810 /* Compute width and height of the tooltip. */
9812 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9814 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9818 /* Stop at the first empty row at the end. */
9819 if (!row
->enabled_p
|| !row
->displays_text_p
)
9822 /* Let the row go over the full width of the frame. */
9823 row
->full_width_p
= 1;
9825 /* There's a glyph at the end of rows that is use to place
9826 the cursor there. Don't include the width of this glyph. */
9827 if (row
->used
[TEXT_AREA
])
9829 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9830 row_width
= row
->pixel_width
- last
->pixel_width
;
9833 row_width
= row
->pixel_width
;
9835 height
+= row
->height
;
9836 width
= max (width
, row_width
);
9839 /* Add the frame's internal border to the width and height the X
9840 window should have. */
9841 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9842 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9844 /* Move the tooltip window where the mouse pointer is. Resize and
9847 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9848 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9849 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9850 root_x
+ 5, root_y
- height
- 5, width
, height
);
9851 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9854 /* Draw into the window. */
9855 w
->must_be_updated_p
= 1;
9856 update_single_window (w
, 1);
9858 /* Restore original current buffer. */
9859 set_buffer_internal_1 (old_buffer
);
9860 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9862 /* Let the tip disappear after timeout seconds. */
9863 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9864 intern ("x-hide-tip"));
9866 return unbind_to (count
, Qnil
);
9870 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9871 "Hide the current tooltip window, if there is any.\n\
9872 Value is t is tooltip was open, nil otherwise.")
9875 int count
= specpdl_ptr
- specpdl
;
9878 specbind (Qinhibit_redisplay
, Qt
);
9880 if (!NILP (tip_timer
))
9882 call1 (intern ("cancel-timer"), tip_timer
);
9890 XSETFRAME (frame
, tip_frame
);
9891 Fdelete_frame (frame
, Qt
);
9896 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9901 /***********************************************************************
9902 File selection dialog
9903 ***********************************************************************/
9907 /* Callback for "OK" and "Cancel" on file selection dialog. */
9910 file_dialog_cb (widget
, client_data
, call_data
)
9912 XtPointer call_data
, client_data
;
9914 int *result
= (int *) client_data
;
9915 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9916 *result
= cb
->reason
;
9920 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9921 "Read file name, prompting with PROMPT in directory DIR.\n\
9922 Use a file selection dialog.\n\
9923 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9924 specified. Don't let the user enter a file name in the file\n\
9925 selection dialog's entry field, if MUSTMATCH is non-nil.")
9926 (prompt
, dir
, default_filename
, mustmatch
)
9927 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9930 struct frame
*f
= selected_frame
;
9931 Lisp_Object file
= Qnil
;
9932 Widget dialog
, text
, list
, help
;
9935 extern XtAppContext Xt_app_con
;
9937 XmString dir_xmstring
, pattern_xmstring
;
9938 int popup_activated_flag
;
9939 int count
= specpdl_ptr
- specpdl
;
9940 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9942 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9943 CHECK_STRING (prompt
, 0);
9944 CHECK_STRING (dir
, 1);
9946 /* Prevent redisplay. */
9947 specbind (Qinhibit_redisplay
, Qt
);
9951 /* Create the dialog with PROMPT as title, using DIR as initial
9952 directory and using "*" as pattern. */
9953 dir
= Fexpand_file_name (dir
, Qnil
);
9954 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9955 pattern_xmstring
= XmStringCreateLocalized ("*");
9957 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9958 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9959 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9960 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9961 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9962 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9964 XmStringFree (dir_xmstring
);
9965 XmStringFree (pattern_xmstring
);
9967 /* Add callbacks for OK and Cancel. */
9968 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9969 (XtPointer
) &result
);
9970 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9971 (XtPointer
) &result
);
9973 /* Disable the help button since we can't display help. */
9974 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9975 XtSetSensitive (help
, False
);
9977 /* Mark OK button as default. */
9978 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
9979 XmNshowAsDefault
, True
, NULL
);
9981 /* If MUSTMATCH is non-nil, disable the file entry field of the
9982 dialog, so that the user must select a file from the files list
9983 box. We can't remove it because we wouldn't have a way to get at
9984 the result file name, then. */
9985 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
9986 if (!NILP (mustmatch
))
9989 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
9990 XtSetSensitive (text
, False
);
9991 XtSetSensitive (label
, False
);
9994 /* Manage the dialog, so that list boxes get filled. */
9995 XtManageChild (dialog
);
9997 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
9998 must include the path for this to work. */
9999 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10000 if (STRINGP (default_filename
))
10002 XmString default_xmstring
;
10006 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10008 if (!XmListItemExists (list
, default_xmstring
))
10010 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10011 XmListAddItem (list
, default_xmstring
, 0);
10015 item_pos
= XmListItemPos (list
, default_xmstring
);
10016 XmStringFree (default_xmstring
);
10018 /* Select the item and scroll it into view. */
10019 XmListSelectPos (list
, item_pos
, True
);
10020 XmListSetPos (list
, item_pos
);
10023 /* Process all events until the user presses Cancel or OK. */
10024 for (result
= 0; result
== 0;)
10027 Widget widget
, parent
;
10029 XtAppNextEvent (Xt_app_con
, &event
);
10031 /* See if the receiver of the event is one of the widgets of
10032 the file selection dialog. If so, dispatch it. If not,
10034 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10036 while (parent
&& parent
!= dialog
)
10037 parent
= XtParent (parent
);
10039 if (parent
== dialog
10040 || (event
.type
== Expose
10041 && !process_expose_from_menu (event
)))
10042 XtDispatchEvent (&event
);
10045 /* Get the result. */
10046 if (result
== XmCR_OK
)
10051 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10052 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10053 XmStringFree (text
);
10054 file
= build_string (data
);
10061 XtUnmanageChild (dialog
);
10062 XtDestroyWidget (dialog
);
10066 /* Make "Cancel" equivalent to C-g. */
10068 Fsignal (Qquit
, Qnil
);
10070 return unbind_to (count
, file
);
10073 #endif /* USE_MOTIF */
10076 /***********************************************************************
10078 ***********************************************************************/
10082 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10083 "Value is non-nil if SPEC is a valid image specification.")
10087 return valid_image_p (spec
) ? Qt
: Qnil
;
10091 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10097 if (valid_image_p (spec
))
10098 id
= lookup_image (selected_frame
, spec
);
10100 debug_print (spec
);
10101 return make_number (id
);
10104 #endif /* GLYPH_DEBUG != 0 */
10108 /***********************************************************************
10110 ***********************************************************************/
10115 /* This is zero if not using X windows. */
10118 /* The section below is built by the lisp expression at the top of the file,
10119 just above where these variables are declared. */
10120 /*&&& init symbols here &&&*/
10121 Qauto_raise
= intern ("auto-raise");
10122 staticpro (&Qauto_raise
);
10123 Qauto_lower
= intern ("auto-lower");
10124 staticpro (&Qauto_lower
);
10125 Qbar
= intern ("bar");
10127 Qborder_color
= intern ("border-color");
10128 staticpro (&Qborder_color
);
10129 Qborder_width
= intern ("border-width");
10130 staticpro (&Qborder_width
);
10131 Qbox
= intern ("box");
10133 Qcursor_color
= intern ("cursor-color");
10134 staticpro (&Qcursor_color
);
10135 Qcursor_type
= intern ("cursor-type");
10136 staticpro (&Qcursor_type
);
10137 Qgeometry
= intern ("geometry");
10138 staticpro (&Qgeometry
);
10139 Qicon_left
= intern ("icon-left");
10140 staticpro (&Qicon_left
);
10141 Qicon_top
= intern ("icon-top");
10142 staticpro (&Qicon_top
);
10143 Qicon_type
= intern ("icon-type");
10144 staticpro (&Qicon_type
);
10145 Qicon_name
= intern ("icon-name");
10146 staticpro (&Qicon_name
);
10147 Qinternal_border_width
= intern ("internal-border-width");
10148 staticpro (&Qinternal_border_width
);
10149 Qleft
= intern ("left");
10150 staticpro (&Qleft
);
10151 Qright
= intern ("right");
10152 staticpro (&Qright
);
10153 Qmouse_color
= intern ("mouse-color");
10154 staticpro (&Qmouse_color
);
10155 Qnone
= intern ("none");
10156 staticpro (&Qnone
);
10157 Qparent_id
= intern ("parent-id");
10158 staticpro (&Qparent_id
);
10159 Qscroll_bar_width
= intern ("scroll-bar-width");
10160 staticpro (&Qscroll_bar_width
);
10161 Qsuppress_icon
= intern ("suppress-icon");
10162 staticpro (&Qsuppress_icon
);
10163 Qundefined_color
= intern ("undefined-color");
10164 staticpro (&Qundefined_color
);
10165 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10166 staticpro (&Qvertical_scroll_bars
);
10167 Qvisibility
= intern ("visibility");
10168 staticpro (&Qvisibility
);
10169 Qwindow_id
= intern ("window-id");
10170 staticpro (&Qwindow_id
);
10171 Qouter_window_id
= intern ("outer-window-id");
10172 staticpro (&Qouter_window_id
);
10173 Qx_frame_parameter
= intern ("x-frame-parameter");
10174 staticpro (&Qx_frame_parameter
);
10175 Qx_resource_name
= intern ("x-resource-name");
10176 staticpro (&Qx_resource_name
);
10177 Quser_position
= intern ("user-position");
10178 staticpro (&Quser_position
);
10179 Quser_size
= intern ("user-size");
10180 staticpro (&Quser_size
);
10181 Qdisplay
= intern ("display");
10182 staticpro (&Qdisplay
);
10183 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10184 staticpro (&Qscroll_bar_foreground
);
10185 Qscroll_bar_background
= intern ("scroll-bar-background");
10186 staticpro (&Qscroll_bar_background
);
10187 Qscreen_gamma
= intern ("screen-gamma");
10188 staticpro (&Qscreen_gamma
);
10189 /* This is the end of symbol initialization. */
10191 Qlaplace
= intern ("laplace");
10192 staticpro (&Qlaplace
);
10194 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10195 staticpro (&Qface_set_after_frame_default
);
10197 Fput (Qundefined_color
, Qerror_conditions
,
10198 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10199 Fput (Qundefined_color
, Qerror_message
,
10200 build_string ("Undefined color"));
10202 init_x_parm_symbols ();
10204 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10205 "List of directories to search for bitmap files for X.");
10206 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10208 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10209 "The shape of the pointer when over text.\n\
10210 Changing the value does not affect existing frames\n\
10211 unless you set the mouse color.");
10212 Vx_pointer_shape
= Qnil
;
10214 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10215 "The name Emacs uses to look up X resources.\n\
10216 `x-get-resource' uses this as the first component of the instance name\n\
10217 when requesting resource values.\n\
10218 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10219 was invoked, or to the value specified with the `-name' or `-rn'\n\
10220 switches, if present.\n\
10222 It may be useful to bind this variable locally around a call\n\
10223 to `x-get-resource'. See also the variable `x-resource-class'.");
10224 Vx_resource_name
= Qnil
;
10226 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10227 "The class Emacs uses to look up X resources.\n\
10228 `x-get-resource' uses this as the first component of the instance class\n\
10229 when requesting resource values.\n\
10230 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10232 Setting this variable permanently is not a reasonable thing to do,\n\
10233 but binding this variable locally around a call to `x-get-resource'\n\
10234 is a reasonable practice. See also the variable `x-resource-name'.");
10235 Vx_resource_class
= build_string (EMACS_CLASS
);
10237 #if 0 /* This doesn't really do anything. */
10238 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10239 "The shape of the pointer when not over text.\n\
10240 This variable takes effect when you create a new frame\n\
10241 or when you set the mouse color.");
10243 Vx_nontext_pointer_shape
= Qnil
;
10245 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10246 "The shape of the pointer when Emacs is busy.\n\
10247 This variable takes effect when you create a new frame\n\
10248 or when you set the mouse color.");
10249 Vx_busy_pointer_shape
= Qnil
;
10251 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10252 "Non-zero means Emacs displays a busy cursor on window systems.");
10253 display_busy_cursor_p
= 1;
10255 #if 0 /* This doesn't really do anything. */
10256 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10257 "The shape of the pointer when over the mode line.\n\
10258 This variable takes effect when you create a new frame\n\
10259 or when you set the mouse color.");
10261 Vx_mode_pointer_shape
= Qnil
;
10263 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10264 &Vx_sensitive_text_pointer_shape
,
10265 "The shape of the pointer when over mouse-sensitive text.\n\
10266 This variable takes effect when you create a new frame\n\
10267 or when you set the mouse color.");
10268 Vx_sensitive_text_pointer_shape
= Qnil
;
10270 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10271 "A string indicating the foreground color of the cursor box.");
10272 Vx_cursor_fore_pixel
= Qnil
;
10274 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10275 "Non-nil if no X window manager is in use.\n\
10276 Emacs doesn't try to figure this out; this is always nil\n\
10277 unless you set it to something else.");
10278 /* We don't have any way to find this out, so set it to nil
10279 and maybe the user would like to set it to t. */
10280 Vx_no_window_manager
= Qnil
;
10282 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10283 &Vx_pixel_size_width_font_regexp
,
10284 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10286 Since Emacs gets width of a font matching with this regexp from\n\
10287 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10288 such a font. This is especially effective for such large fonts as\n\
10289 Chinese, Japanese, and Korean.");
10290 Vx_pixel_size_width_font_regexp
= Qnil
;
10292 DEFVAR_LISP ("image-eviction-seconds", &Vimage_eviction_seconds
,
10293 "Time after which cached images are removed from the cache.\n\
10294 When an image has not been displayed this many seconds, remove it\n\
10295 from the image cache. Value must be an integer or nil with nil\n\
10296 meaning don't clear the cache.");
10297 Vimage_eviction_seconds
= make_number (30 * 60);
10299 DEFVAR_LISP ("image-types", &Vimage_types
,
10300 "List of supported image types.\n\
10301 Each element of the list is a symbol for a supported image type.");
10302 Vimage_types
= Qnil
;
10304 #ifdef USE_X_TOOLKIT
10305 Fprovide (intern ("x-toolkit"));
10308 Fprovide (intern ("motif"));
10311 defsubr (&Sx_get_resource
);
10313 /* X window properties. */
10314 defsubr (&Sx_change_window_property
);
10315 defsubr (&Sx_delete_window_property
);
10316 defsubr (&Sx_window_property
);
10319 defsubr (&Sx_draw_rectangle
);
10320 defsubr (&Sx_erase_rectangle
);
10321 defsubr (&Sx_contour_region
);
10322 defsubr (&Sx_uncontour_region
);
10324 defsubr (&Sx_display_color_p
);
10325 defsubr (&Sx_display_grayscale_p
);
10326 defsubr (&Sx_color_defined_p
);
10327 defsubr (&Sx_color_values
);
10328 defsubr (&Sx_server_max_request_size
);
10329 defsubr (&Sx_server_vendor
);
10330 defsubr (&Sx_server_version
);
10331 defsubr (&Sx_display_pixel_width
);
10332 defsubr (&Sx_display_pixel_height
);
10333 defsubr (&Sx_display_mm_width
);
10334 defsubr (&Sx_display_mm_height
);
10335 defsubr (&Sx_display_screens
);
10336 defsubr (&Sx_display_planes
);
10337 defsubr (&Sx_display_color_cells
);
10338 defsubr (&Sx_display_visual_class
);
10339 defsubr (&Sx_display_backing_store
);
10340 defsubr (&Sx_display_save_under
);
10342 defsubr (&Sx_rebind_key
);
10343 defsubr (&Sx_rebind_keys
);
10344 defsubr (&Sx_track_pointer
);
10345 defsubr (&Sx_grab_pointer
);
10346 defsubr (&Sx_ungrab_pointer
);
10348 defsubr (&Sx_parse_geometry
);
10349 defsubr (&Sx_create_frame
);
10351 defsubr (&Sx_horizontal_line
);
10353 defsubr (&Sx_open_connection
);
10354 defsubr (&Sx_close_connection
);
10355 defsubr (&Sx_display_list
);
10356 defsubr (&Sx_synchronize
);
10358 /* Setting callback functions for fontset handler. */
10359 get_font_info_func
= x_get_font_info
;
10361 #if 0 /* This function pointer doesn't seem to be used anywhere.
10362 And the pointer assigned has the wrong type, anyway. */
10363 list_fonts_func
= x_list_fonts
;
10366 load_font_func
= x_load_font
;
10367 find_ccl_program_func
= x_find_ccl_program
;
10368 query_font_func
= x_query_font
;
10369 set_frame_fontset_func
= x_set_font
;
10370 check_window_system_func
= check_x
;
10373 Qxbm
= intern ("xbm");
10375 QCtype
= intern (":type");
10376 staticpro (&QCtype
);
10377 QCfile
= intern (":file");
10378 staticpro (&QCfile
);
10379 QCalgorithm
= intern (":algorithm");
10380 staticpro (&QCalgorithm
);
10381 QCheuristic_mask
= intern (":heuristic-mask");
10382 staticpro (&QCheuristic_mask
);
10383 QCcolor_symbols
= intern (":color-symbols");
10384 staticpro (&QCcolor_symbols
);
10385 QCdata
= intern (":data");
10386 staticpro (&QCdata
);
10387 QCascent
= intern (":ascent");
10388 staticpro (&QCascent
);
10389 QCmargin
= intern (":margin");
10390 staticpro (&QCmargin
);
10391 QCrelief
= intern (":relief");
10392 staticpro (&QCrelief
);
10393 Qghostscript
= intern ("ghostscript");
10394 staticpro (&Qghostscript
);
10395 QCloader
= intern (":loader");
10396 staticpro (&QCloader
);
10397 QCbounding_box
= intern (":bounding-box");
10398 staticpro (&QCbounding_box
);
10399 QCpt_width
= intern (":pt-width");
10400 staticpro (&QCpt_width
);
10401 QCpt_height
= intern (":pt-height");
10402 staticpro (&QCpt_height
);
10403 QCindex
= intern (":index");
10404 staticpro (&QCindex
);
10405 Qpbm
= intern ("pbm");
10409 Qxpm
= intern ("xpm");
10414 Qjpeg
= intern ("jpeg");
10415 staticpro (&Qjpeg
);
10419 Qtiff
= intern ("tiff");
10420 staticpro (&Qtiff
);
10424 Qgif
= intern ("gif");
10429 Qpng
= intern ("png");
10433 defsubr (&Sclear_image_cache
);
10436 defsubr (&Simagep
);
10437 defsubr (&Slookup_image
);
10441 defsubr (&Sx_show_busy_cursor
);
10442 defsubr (&Sx_hide_busy_cursor
);
10444 inhibit_busy_cursor
= 0;
10446 defsubr (&Sx_show_tip
);
10447 defsubr (&Sx_hide_tip
);
10448 staticpro (&tip_timer
);
10452 defsubr (&Sx_file_dialog
);
10460 image_types
= NULL
;
10461 Vimage_types
= Qnil
;
10463 define_image_type (&xbm_type
);
10464 define_image_type (&gs_type
);
10465 define_image_type (&pbm_type
);
10468 define_image_type (&xpm_type
);
10472 define_image_type (&jpeg_type
);
10476 define_image_type (&tiff_type
);
10480 define_image_type (&gif_type
);
10484 define_image_type (&png_type
);
10488 #endif /* HAVE_X_WINDOWS */