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"
60 /* On some systems, the character-composition stuff is broken in X11R5. */
62 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
63 #ifdef X11R5_INHIBIT_I18N
64 #define X_I18N_INHIBITED
69 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
70 #include "bitmaps/gray.xbm"
72 #include <X11/bitmaps/gray>
75 #include "[.bitmaps]gray.xbm"
79 #include <X11/Shell.h>
82 #include <X11/Xaw/Paned.h>
83 #include <X11/Xaw/Label.h>
84 #endif /* USE_MOTIF */
87 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
96 #include "../lwlib/lwlib.h"
100 #include <Xm/DialogS.h>
101 #include <Xm/FileSB.h>
104 /* Do the EDITRES protocol if running X11R5
105 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
107 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
109 extern void _XEditResCheckMessages ();
110 #endif /* R5 + Athena */
112 /* Unique id counter for widgets created by the Lucid Widget Library. */
114 extern LWLIB_ID widget_id_tick
;
117 /* This is part of a kludge--see lwlib/xlwmenu.c. */
118 extern XFontStruct
*xlwmenu_default_font
;
121 extern void free_frame_menubar ();
122 extern double atof ();
124 #endif /* USE_X_TOOLKIT */
126 #define min(a,b) ((a) < (b) ? (a) : (b))
127 #define max(a,b) ((a) > (b) ? (a) : (b))
130 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
132 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
135 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
136 it, and including `bitmaps/gray' more than once is a problem when
137 config.h defines `static' as an empty replacement string. */
139 int gray_bitmap_width
= gray_width
;
140 int gray_bitmap_height
= gray_height
;
141 unsigned char *gray_bitmap_bits
= gray_bits
;
143 /* The name we're using in resource queries. Most often "emacs". */
145 Lisp_Object Vx_resource_name
;
147 /* The application class we're using in resource queries.
150 Lisp_Object Vx_resource_class
;
152 /* Non-zero means we're allowed to display a busy cursor. */
154 int display_busy_cursor_p
;
156 /* The background and shape of the mouse pointer, and shape when not
157 over text or in the modeline. */
159 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
160 Lisp_Object Vx_busy_pointer_shape
;
162 /* The shape when over mouse-sensitive text. */
164 Lisp_Object Vx_sensitive_text_pointer_shape
;
166 /* Color of chars displayed in cursor box. */
168 Lisp_Object Vx_cursor_fore_pixel
;
170 /* Nonzero if using X. */
174 /* Non nil if no window manager is in use. */
176 Lisp_Object Vx_no_window_manager
;
178 /* Search path for bitmap files. */
180 Lisp_Object Vx_bitmap_file_path
;
182 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
184 Lisp_Object Vx_pixel_size_width_font_regexp
;
186 /* Evaluate this expression to rebuild the section of syms_of_xfns
187 that initializes and staticpros the symbols declared below. Note
188 that Emacs 18 has a bug that keeps C-x C-e from being able to
189 evaluate this expression.
192 ;; Accumulate a list of the symbols we want to initialize from the
193 ;; declarations at the top of the file.
194 (goto-char (point-min))
195 (search-forward "/\*&&& symbols declared here &&&*\/\n")
197 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
199 (cons (buffer-substring (match-beginning 1) (match-end 1))
202 (setq symbol-list (nreverse symbol-list))
203 ;; Delete the section of syms_of_... where we initialize the symbols.
204 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
205 (let ((start (point)))
206 (while (looking-at "^ Q")
208 (kill-region start (point)))
209 ;; Write a new symbol initialization section.
211 (insert (format " %s = intern (\"" (car symbol-list)))
212 (let ((start (point)))
213 (insert (substring (car symbol-list) 1))
214 (subst-char-in-region start (point) ?_ ?-))
215 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
216 (setq symbol-list (cdr symbol-list)))))
220 /*&&& symbols declared here &&&*/
221 Lisp_Object Qauto_raise
;
222 Lisp_Object Qauto_lower
;
224 Lisp_Object Qborder_color
;
225 Lisp_Object Qborder_width
;
227 Lisp_Object Qcursor_color
;
228 Lisp_Object Qcursor_type
;
229 Lisp_Object Qgeometry
;
230 Lisp_Object Qicon_left
;
231 Lisp_Object Qicon_top
;
232 Lisp_Object Qicon_type
;
233 Lisp_Object Qicon_name
;
234 Lisp_Object Qinternal_border_width
;
237 Lisp_Object Qmouse_color
;
239 Lisp_Object Qouter_window_id
;
240 Lisp_Object Qparent_id
;
241 Lisp_Object Qscroll_bar_width
;
242 Lisp_Object Qsuppress_icon
;
243 extern Lisp_Object Qtop
;
244 Lisp_Object Qundefined_color
;
245 Lisp_Object Qvertical_scroll_bars
;
246 Lisp_Object Qvisibility
;
247 Lisp_Object Qwindow_id
;
248 Lisp_Object Qx_frame_parameter
;
249 Lisp_Object Qx_resource_name
;
250 Lisp_Object Quser_position
;
251 Lisp_Object Quser_size
;
252 Lisp_Object Qdisplay
;
253 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
254 Lisp_Object Qscreen_gamma
;
256 /* The below are defined in frame.c. */
258 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
259 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
260 extern Lisp_Object Qtool_bar_lines
;
262 extern Lisp_Object Vwindow_system_version
;
264 Lisp_Object Qface_set_after_frame_default
;
267 /* Error if we are not connected to X. */
273 error ("X windows are not in use or not initialized");
276 /* Nonzero if we can use mouse menus.
277 You should not call this unless HAVE_MENUS is defined. */
285 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
286 and checking validity for X. */
289 check_x_frame (frame
)
295 frame
= selected_frame
;
296 CHECK_LIVE_FRAME (frame
, 0);
299 error ("Non-X frame used");
303 /* Let the user specify an X display with a frame.
304 nil stands for the selected frame--or, if that is not an X frame,
305 the first X display on the list. */
307 static struct x_display_info
*
308 check_x_display_info (frame
)
313 struct frame
*sf
= XFRAME (selected_frame
);
315 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
316 return FRAME_X_DISPLAY_INFO (sf
);
317 else if (x_display_list
!= 0)
318 return x_display_list
;
320 error ("X windows are not in use or not initialized");
322 else if (STRINGP (frame
))
323 return x_display_info_for_name (frame
);
328 CHECK_LIVE_FRAME (frame
, 0);
331 error ("Non-X frame used");
332 return FRAME_X_DISPLAY_INFO (f
);
337 /* Return the Emacs frame-object corresponding to an X window.
338 It could be the frame's main window or an icon window. */
340 /* This function can be called during GC, so use GC_xxx type test macros. */
343 x_window_to_frame (dpyinfo
, wdesc
)
344 struct x_display_info
*dpyinfo
;
347 Lisp_Object tail
, frame
;
350 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
353 if (!GC_FRAMEP (frame
))
356 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
359 if ((f
->output_data
.x
->edit_widget
360 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
361 /* A tooltip frame? */
362 || (!f
->output_data
.x
->edit_widget
363 && FRAME_X_WINDOW (f
) == wdesc
)
364 || f
->output_data
.x
->icon_desc
== wdesc
)
366 #else /* not USE_X_TOOLKIT */
367 if (FRAME_X_WINDOW (f
) == wdesc
368 || f
->output_data
.x
->icon_desc
== wdesc
)
370 #endif /* not USE_X_TOOLKIT */
376 /* Like x_window_to_frame but also compares the window with the widget's
380 x_any_window_to_frame (dpyinfo
, wdesc
)
381 struct x_display_info
*dpyinfo
;
384 Lisp_Object tail
, frame
;
388 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
391 if (!GC_FRAMEP (frame
))
394 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
396 x
= f
->output_data
.x
;
397 /* This frame matches if the window is any of its widgets. */
400 if (wdesc
== XtWindow (x
->widget
)
401 || wdesc
== XtWindow (x
->column_widget
)
402 || wdesc
== XtWindow (x
->edit_widget
))
404 /* Match if the window is this frame's menubar. */
405 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
408 else if (FRAME_X_WINDOW (f
) == wdesc
)
409 /* A tooltip frame. */
415 /* Likewise, but exclude the menu bar widget. */
418 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
419 struct x_display_info
*dpyinfo
;
422 Lisp_Object tail
, frame
;
426 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
429 if (!GC_FRAMEP (frame
))
432 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
434 x
= f
->output_data
.x
;
435 /* This frame matches if the window is any of its widgets. */
438 if (wdesc
== XtWindow (x
->widget
)
439 || wdesc
== XtWindow (x
->column_widget
)
440 || wdesc
== XtWindow (x
->edit_widget
))
443 else if (FRAME_X_WINDOW (f
) == wdesc
)
444 /* A tooltip frame. */
450 /* Likewise, but consider only the menu bar widget. */
453 x_menubar_window_to_frame (dpyinfo
, wdesc
)
454 struct x_display_info
*dpyinfo
;
457 Lisp_Object tail
, frame
;
461 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
464 if (!GC_FRAMEP (frame
))
467 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
469 x
= f
->output_data
.x
;
470 /* Match if the window is this frame's menubar. */
471 if (x
->menubar_widget
472 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
478 /* Return the frame whose principal (outermost) window is WDESC.
479 If WDESC is some other (smaller) window, we return 0. */
482 x_top_window_to_frame (dpyinfo
, wdesc
)
483 struct x_display_info
*dpyinfo
;
486 Lisp_Object tail
, frame
;
490 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
493 if (!GC_FRAMEP (frame
))
496 if (f
->output_data
.nothing
== 1 || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
498 x
= f
->output_data
.x
;
502 /* This frame matches if the window is its topmost widget. */
503 if (wdesc
== XtWindow (x
->widget
))
505 #if 0 /* I don't know why it did this,
506 but it seems logically wrong,
507 and it causes trouble for MapNotify events. */
508 /* Match if the window is this frame's menubar. */
509 if (x
->menubar_widget
510 && wdesc
== XtWindow (x
->menubar_widget
))
514 else if (FRAME_X_WINDOW (f
) == wdesc
)
520 #endif /* USE_X_TOOLKIT */
524 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
525 id, which is just an int that this section returns. Bitmaps are
526 reference counted so they can be shared among frames.
528 Bitmap indices are guaranteed to be > 0, so a negative number can
529 be used to indicate no bitmap.
531 If you use x_create_bitmap_from_data, then you must keep track of
532 the bitmaps yourself. That is, creating a bitmap from the same
533 data more than once will not be caught. */
536 /* Functions to access the contents of a bitmap, given an id. */
539 x_bitmap_height (f
, id
)
543 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
547 x_bitmap_width (f
, id
)
551 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
555 x_bitmap_pixmap (f
, id
)
559 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
563 /* Allocate a new bitmap record. Returns index of new record. */
566 x_allocate_bitmap_record (f
)
569 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
572 if (dpyinfo
->bitmaps
== NULL
)
574 dpyinfo
->bitmaps_size
= 10;
576 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
577 dpyinfo
->bitmaps_last
= 1;
581 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
582 return ++dpyinfo
->bitmaps_last
;
584 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
585 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
588 dpyinfo
->bitmaps_size
*= 2;
590 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
591 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
592 return ++dpyinfo
->bitmaps_last
;
595 /* Add one reference to the reference count of the bitmap with id ID. */
598 x_reference_bitmap (f
, id
)
602 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
605 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
608 x_create_bitmap_from_data (f
, bits
, width
, height
)
611 unsigned int width
, height
;
613 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
617 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
618 bits
, width
, height
);
623 id
= x_allocate_bitmap_record (f
);
624 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
625 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
626 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
627 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
628 dpyinfo
->bitmaps
[id
- 1].height
= height
;
629 dpyinfo
->bitmaps
[id
- 1].width
= width
;
634 /* Create bitmap from file FILE for frame F. */
637 x_create_bitmap_from_file (f
, file
)
641 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
642 unsigned int width
, height
;
644 int xhot
, yhot
, result
, id
;
649 /* Look for an existing bitmap with the same name. */
650 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
652 if (dpyinfo
->bitmaps
[id
].refcount
653 && dpyinfo
->bitmaps
[id
].file
654 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
656 ++dpyinfo
->bitmaps
[id
].refcount
;
661 /* Search bitmap-file-path for the file, if appropriate. */
662 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
665 /* XReadBitmapFile won't handle magic file names. */
670 filename
= (char *) XSTRING (found
)->data
;
672 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
673 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
674 if (result
!= BitmapSuccess
)
677 id
= x_allocate_bitmap_record (f
);
678 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
679 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
680 dpyinfo
->bitmaps
[id
- 1].file
681 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
682 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
683 dpyinfo
->bitmaps
[id
- 1].height
= height
;
684 dpyinfo
->bitmaps
[id
- 1].width
= width
;
685 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
690 /* Remove reference to bitmap with id number ID. */
693 x_destroy_bitmap (f
, id
)
697 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
701 --dpyinfo
->bitmaps
[id
- 1].refcount
;
702 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
705 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
706 if (dpyinfo
->bitmaps
[id
- 1].file
)
708 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
709 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
716 /* Free all the bitmaps for the display specified by DPYINFO. */
719 x_destroy_all_bitmaps (dpyinfo
)
720 struct x_display_info
*dpyinfo
;
723 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
724 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
726 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
727 if (dpyinfo
->bitmaps
[i
].file
)
728 xfree (dpyinfo
->bitmaps
[i
].file
);
730 dpyinfo
->bitmaps_last
= 0;
733 /* Connect the frame-parameter names for X frames
734 to the ways of passing the parameter values to the window system.
736 The name of a parameter, as a Lisp symbol,
737 has an `x-frame-parameter' property which is an integer in Lisp
738 that is an index in this table. */
740 struct x_frame_parm_table
743 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
755 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
758 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
763 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
767 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
768 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
769 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
771 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
773 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
778 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
780 static struct x_frame_parm_table x_frame_parms
[] =
782 "auto-raise", x_set_autoraise
,
783 "auto-lower", x_set_autolower
,
784 "background-color", x_set_background_color
,
785 "border-color", x_set_border_color
,
786 "border-width", x_set_border_width
,
787 "cursor-color", x_set_cursor_color
,
788 "cursor-type", x_set_cursor_type
,
790 "foreground-color", x_set_foreground_color
,
791 "icon-name", x_set_icon_name
,
792 "icon-type", x_set_icon_type
,
793 "internal-border-width", x_set_internal_border_width
,
794 "menu-bar-lines", x_set_menu_bar_lines
,
795 "mouse-color", x_set_mouse_color
,
796 "name", x_explicitly_set_name
,
797 "scroll-bar-width", x_set_scroll_bar_width
,
798 "title", x_set_title
,
799 "unsplittable", x_set_unsplittable
,
800 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
801 "visibility", x_set_visibility
,
802 "tool-bar-lines", x_set_tool_bar_lines
,
803 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
804 "scroll-bar-background", x_set_scroll_bar_background
,
805 "screen-gamma", x_set_screen_gamma
808 /* Attach the `x-frame-parameter' properties to
809 the Lisp symbol names of parameters relevant to X. */
812 init_x_parm_symbols ()
816 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
817 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
821 /* Change the parameters of frame F as specified by ALIST.
822 If a parameter is not specially recognized, do nothing;
823 otherwise call the `x_set_...' function for that parameter. */
826 x_set_frame_parameters (f
, alist
)
832 /* If both of these parameters are present, it's more efficient to
833 set them both at once. So we wait until we've looked at the
834 entire list before we set them. */
838 Lisp_Object left
, top
;
840 /* Same with these. */
841 Lisp_Object icon_left
, icon_top
;
843 /* Record in these vectors all the parms specified. */
847 int left_no_change
= 0, top_no_change
= 0;
848 int icon_left_no_change
= 0, icon_top_no_change
= 0;
850 struct gcpro gcpro1
, gcpro2
;
853 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
856 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
857 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
859 /* Extract parm names and values into those vectors. */
862 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
867 parms
[i
] = Fcar (elt
);
868 values
[i
] = Fcdr (elt
);
871 /* TAIL and ALIST are not used again below here. */
874 GCPRO2 (*parms
, *values
);
878 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
879 because their values appear in VALUES and strings are not valid. */
880 top
= left
= Qunbound
;
881 icon_left
= icon_top
= Qunbound
;
883 /* Provide default values for HEIGHT and WIDTH. */
884 if (FRAME_NEW_WIDTH (f
))
885 width
= FRAME_NEW_WIDTH (f
);
887 width
= FRAME_WIDTH (f
);
889 if (FRAME_NEW_HEIGHT (f
))
890 height
= FRAME_NEW_HEIGHT (f
);
892 height
= FRAME_HEIGHT (f
);
894 /* Process foreground_color and background_color before anything else.
895 They are independent of other properties, but other properties (e.g.,
896 cursor_color) are dependent upon them. */
897 for (p
= 0; p
< i
; p
++)
899 Lisp_Object prop
, val
;
903 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
905 register Lisp_Object param_index
, old_value
;
907 param_index
= Fget (prop
, Qx_frame_parameter
);
908 old_value
= get_frame_param (f
, prop
);
909 store_frame_param (f
, prop
, val
);
910 if (NATNUMP (param_index
)
911 && (XFASTINT (param_index
)
912 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
913 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
917 /* Now process them in reverse of specified order. */
918 for (i
--; i
>= 0; i
--)
920 Lisp_Object prop
, val
;
925 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
926 width
= XFASTINT (val
);
927 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
928 height
= XFASTINT (val
);
929 else if (EQ (prop
, Qtop
))
931 else if (EQ (prop
, Qleft
))
933 else if (EQ (prop
, Qicon_top
))
935 else if (EQ (prop
, Qicon_left
))
937 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
938 /* Processed above. */
942 register Lisp_Object param_index
, old_value
;
944 param_index
= Fget (prop
, Qx_frame_parameter
);
945 old_value
= get_frame_param (f
, prop
);
946 store_frame_param (f
, prop
, val
);
947 if (NATNUMP (param_index
)
948 && (XFASTINT (param_index
)
949 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
950 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
954 /* Don't die if just one of these was set. */
955 if (EQ (left
, Qunbound
))
958 if (f
->output_data
.x
->left_pos
< 0)
959 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
961 XSETINT (left
, f
->output_data
.x
->left_pos
);
963 if (EQ (top
, Qunbound
))
966 if (f
->output_data
.x
->top_pos
< 0)
967 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
969 XSETINT (top
, f
->output_data
.x
->top_pos
);
972 /* If one of the icon positions was not set, preserve or default it. */
973 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
975 icon_left_no_change
= 1;
976 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
977 if (NILP (icon_left
))
978 XSETINT (icon_left
, 0);
980 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
982 icon_top_no_change
= 1;
983 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
985 XSETINT (icon_top
, 0);
988 /* Don't set these parameters unless they've been explicitly
989 specified. The window might be mapped or resized while we're in
990 this function, and we don't want to override that unless the lisp
991 code has asked for it.
993 Don't set these parameters unless they actually differ from the
994 window's current parameters; the window may not actually exist
999 check_frame_size (f
, &height
, &width
);
1001 XSETFRAME (frame
, f
);
1003 if (width
!= FRAME_WIDTH (f
)
1004 || height
!= FRAME_HEIGHT (f
)
1005 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1006 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1008 if ((!NILP (left
) || !NILP (top
))
1009 && ! (left_no_change
&& top_no_change
)
1010 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1011 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1016 /* Record the signs. */
1017 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1018 if (EQ (left
, Qminus
))
1019 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1020 else if (INTEGERP (left
))
1022 leftpos
= XINT (left
);
1024 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1026 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1027 && CONSP (XCDR (left
))
1028 && INTEGERP (XCAR (XCDR (left
))))
1030 leftpos
= - XINT (XCAR (XCDR (left
)));
1031 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1033 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1034 && CONSP (XCDR (left
))
1035 && INTEGERP (XCAR (XCDR (left
))))
1037 leftpos
= XINT (XCAR (XCDR (left
)));
1040 if (EQ (top
, Qminus
))
1041 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1042 else if (INTEGERP (top
))
1044 toppos
= XINT (top
);
1046 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1048 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1049 && CONSP (XCDR (top
))
1050 && INTEGERP (XCAR (XCDR (top
))))
1052 toppos
= - XINT (XCAR (XCDR (top
)));
1053 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1055 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1056 && CONSP (XCDR (top
))
1057 && INTEGERP (XCAR (XCDR (top
))))
1059 toppos
= XINT (XCAR (XCDR (top
)));
1063 /* Store the numeric value of the position. */
1064 f
->output_data
.x
->top_pos
= toppos
;
1065 f
->output_data
.x
->left_pos
= leftpos
;
1067 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1069 /* Actually set that position, and convert to absolute. */
1070 x_set_offset (f
, leftpos
, toppos
, -1);
1073 if ((!NILP (icon_left
) || !NILP (icon_top
))
1074 && ! (icon_left_no_change
&& icon_top_no_change
))
1075 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1081 /* Store the screen positions of frame F into XPTR and YPTR.
1082 These are the positions of the containing window manager window,
1083 not Emacs's own window. */
1086 x_real_positions (f
, xptr
, yptr
)
1093 /* This is pretty gross, but seems to be the easiest way out of
1094 the problem that arises when restarting window-managers. */
1096 #ifdef USE_X_TOOLKIT
1097 Window outer
= (f
->output_data
.x
->widget
1098 ? XtWindow (f
->output_data
.x
->widget
)
1099 : FRAME_X_WINDOW (f
));
1101 Window outer
= f
->output_data
.x
->window_desc
;
1103 Window tmp_root_window
;
1104 Window
*tmp_children
;
1109 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1110 Window outer_window
;
1112 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1113 &f
->output_data
.x
->parent_desc
,
1114 &tmp_children
, &tmp_nchildren
);
1115 XFree ((char *) tmp_children
);
1119 /* Find the position of the outside upper-left corner of
1120 the inner window, with respect to the outer window. */
1121 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1122 outer_window
= f
->output_data
.x
->parent_desc
;
1124 outer_window
= outer
;
1126 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1128 /* From-window, to-window. */
1130 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1132 /* From-position, to-position. */
1133 0, 0, &win_x
, &win_y
,
1138 /* It is possible for the window returned by the XQueryNotify
1139 to become invalid by the time we call XTranslateCoordinates.
1140 That can happen when you restart some window managers.
1141 If so, we get an error in XTranslateCoordinates.
1142 Detect that and try the whole thing over. */
1143 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1145 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1149 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1156 /* Insert a description of internally-recorded parameters of frame X
1157 into the parameter alist *ALISTPTR that is to be given to the user.
1158 Only parameters that are specific to the X window system
1159 and whose values are not correctly recorded in the frame's
1160 param_alist need to be considered here. */
1163 x_report_frame_params (f
, alistptr
)
1165 Lisp_Object
*alistptr
;
1170 /* Represent negative positions (off the top or left screen edge)
1171 in a way that Fmodify_frame_parameters will understand correctly. */
1172 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1173 if (f
->output_data
.x
->left_pos
>= 0)
1174 store_in_alist (alistptr
, Qleft
, tem
);
1176 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1178 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1179 if (f
->output_data
.x
->top_pos
>= 0)
1180 store_in_alist (alistptr
, Qtop
, tem
);
1182 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1184 store_in_alist (alistptr
, Qborder_width
,
1185 make_number (f
->output_data
.x
->border_width
));
1186 store_in_alist (alistptr
, Qinternal_border_width
,
1187 make_number (f
->output_data
.x
->internal_border_width
));
1188 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1189 store_in_alist (alistptr
, Qwindow_id
,
1190 build_string (buf
));
1191 #ifdef USE_X_TOOLKIT
1192 /* Tooltip frame may not have this widget. */
1193 if (f
->output_data
.x
->widget
)
1195 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1196 store_in_alist (alistptr
, Qouter_window_id
,
1197 build_string (buf
));
1198 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1199 FRAME_SAMPLE_VISIBILITY (f
);
1200 store_in_alist (alistptr
, Qvisibility
,
1201 (FRAME_VISIBLE_P (f
) ? Qt
1202 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1203 store_in_alist (alistptr
, Qdisplay
,
1204 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1206 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1209 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1210 store_in_alist (alistptr
, Qparent_id
, tem
);
1215 /* Gamma-correct COLOR on frame F. */
1218 gamma_correct (f
, color
)
1224 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1225 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1226 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1231 /* Decide if color named COLOR is valid for the display associated with
1232 the selected frame; if so, return the rgb values in COLOR_DEF.
1233 If ALLOC is nonzero, allocate a new colormap cell. */
1236 defined_color (f
, color
, color_def
, alloc
)
1242 register int status
;
1243 Colormap screen_colormap
;
1244 Display
*display
= FRAME_X_DISPLAY (f
);
1247 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1249 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1250 if (status
&& alloc
)
1252 /* Apply gamma correction. */
1253 gamma_correct (f
, color_def
);
1255 status
= XAllocColor (display
, screen_colormap
, color_def
);
1258 /* If we got to this point, the colormap is full, so we're
1259 going to try and get the next closest color.
1260 The algorithm used is a least-squares matching, which is
1261 what X uses for closest color matching with StaticColor visuals. */
1266 long nearest_delta
, trial_delta
;
1269 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1270 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1272 for (x
= 0; x
< no_cells
; x
++)
1275 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1277 /* I'm assuming CSE so I'm not going to condense this. */
1278 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1279 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1281 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1282 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1284 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1285 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1286 for (x
= 1; x
< no_cells
; x
++)
1288 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1289 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1291 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1292 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1294 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1295 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1296 if (trial_delta
< nearest_delta
)
1299 temp
.red
= cells
[x
].red
;
1300 temp
.green
= cells
[x
].green
;
1301 temp
.blue
= cells
[x
].blue
;
1302 status
= XAllocColor (display
, screen_colormap
, &temp
);
1306 nearest_delta
= trial_delta
;
1310 color_def
->red
= cells
[nearest
].red
;
1311 color_def
->green
= cells
[nearest
].green
;
1312 color_def
->blue
= cells
[nearest
].blue
;
1313 status
= XAllocColor (display
, screen_colormap
, color_def
);
1324 /* Given a string ARG naming a color, compute a pixel value from it
1325 suitable for screen F.
1326 If F is not a color screen, return DEF (default) regardless of what
1330 x_decode_color (f
, arg
, def
)
1337 CHECK_STRING (arg
, 0);
1339 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1340 return BLACK_PIX_DEFAULT (f
);
1341 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1342 return WHITE_PIX_DEFAULT (f
);
1344 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1347 /* defined_color is responsible for coping with failures
1348 by looking for a near-miss. */
1349 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1352 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1353 Fcons (arg
, Qnil
)));
1356 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1357 the previous value of that parameter, NEW_VALUE is the new value. */
1360 x_set_screen_gamma (f
, new_value
, old_value
)
1362 Lisp_Object new_value
, old_value
;
1364 if (NILP (new_value
))
1366 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1367 /* The value 0.4545 is the normal viewing gamma. */
1368 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1370 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1371 Fcons (new_value
, Qnil
)));
1373 clear_face_cache (0);
1377 /* Functions called only from `x_set_frame_param'
1378 to set individual parameters.
1380 If FRAME_X_WINDOW (f) is 0,
1381 the frame is being created and its X-window does not exist yet.
1382 In that case, just record the parameter's new value
1383 in the standard place; do not attempt to change the window. */
1386 x_set_foreground_color (f
, arg
, oldval
)
1388 Lisp_Object arg
, oldval
;
1391 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1393 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1394 f
->output_data
.x
->foreground_pixel
= pixel
;
1396 if (FRAME_X_WINDOW (f
) != 0)
1399 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1400 f
->output_data
.x
->foreground_pixel
);
1401 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1402 f
->output_data
.x
->foreground_pixel
);
1404 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1405 if (FRAME_VISIBLE_P (f
))
1411 x_set_background_color (f
, arg
, oldval
)
1413 Lisp_Object arg
, oldval
;
1416 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1418 unload_color (f
, f
->output_data
.x
->background_pixel
);
1419 f
->output_data
.x
->background_pixel
= pixel
;
1421 if (FRAME_X_WINDOW (f
) != 0)
1424 /* The main frame area. */
1425 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1426 f
->output_data
.x
->background_pixel
);
1427 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1428 f
->output_data
.x
->background_pixel
);
1429 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1430 f
->output_data
.x
->background_pixel
);
1431 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1432 f
->output_data
.x
->background_pixel
);
1435 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1436 bar
= XSCROLL_BAR (bar
)->next
)
1437 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1438 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1439 f
->output_data
.x
->background_pixel
);
1443 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1445 if (FRAME_VISIBLE_P (f
))
1451 x_set_mouse_color (f
, arg
, oldval
)
1453 Lisp_Object arg
, oldval
;
1455 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1458 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1459 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1461 /* Don't let pointers be invisible. */
1462 if (mask_color
== pixel
1463 && mask_color
== f
->output_data
.x
->background_pixel
)
1464 pixel
= f
->output_data
.x
->foreground_pixel
;
1466 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1467 f
->output_data
.x
->mouse_pixel
= pixel
;
1471 /* It's not okay to crash if the user selects a screwy cursor. */
1472 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1474 if (!EQ (Qnil
, Vx_pointer_shape
))
1476 CHECK_NUMBER (Vx_pointer_shape
, 0);
1477 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1480 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1481 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1483 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1485 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1486 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1487 XINT (Vx_nontext_pointer_shape
));
1490 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1491 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1493 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1495 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1496 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1497 XINT (Vx_busy_pointer_shape
));
1500 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1501 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1503 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1504 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1506 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1507 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1508 XINT (Vx_mode_pointer_shape
));
1511 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1512 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1514 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1516 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1518 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1519 XINT (Vx_sensitive_text_pointer_shape
));
1522 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1524 /* Check and report errors with the above calls. */
1525 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1526 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1529 XColor fore_color
, back_color
;
1531 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1532 back_color
.pixel
= mask_color
;
1533 XQueryColor (FRAME_X_DISPLAY (f
),
1534 DefaultColormap (FRAME_X_DISPLAY (f
),
1535 DefaultScreen (FRAME_X_DISPLAY (f
))),
1537 XQueryColor (FRAME_X_DISPLAY (f
),
1538 DefaultColormap (FRAME_X_DISPLAY (f
),
1539 DefaultScreen (FRAME_X_DISPLAY (f
))),
1541 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1542 &fore_color
, &back_color
);
1543 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1544 &fore_color
, &back_color
);
1545 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1546 &fore_color
, &back_color
);
1547 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1548 &fore_color
, &back_color
);
1549 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1550 &fore_color
, &back_color
);
1553 if (FRAME_X_WINDOW (f
) != 0)
1554 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1556 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1557 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1558 f
->output_data
.x
->text_cursor
= cursor
;
1560 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1561 && f
->output_data
.x
->nontext_cursor
!= 0)
1562 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1563 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1565 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1566 && f
->output_data
.x
->busy_cursor
!= 0)
1567 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1568 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1570 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1571 && f
->output_data
.x
->modeline_cursor
!= 0)
1572 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1573 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1575 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1576 && f
->output_data
.x
->cross_cursor
!= 0)
1577 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1578 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1580 XFlush (FRAME_X_DISPLAY (f
));
1583 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1587 x_set_cursor_color (f
, arg
, oldval
)
1589 Lisp_Object arg
, oldval
;
1591 unsigned long fore_pixel
, pixel
;
1593 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1594 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1595 WHITE_PIX_DEFAULT (f
));
1597 fore_pixel
= f
->output_data
.x
->background_pixel
;
1598 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1600 /* Make sure that the cursor color differs from the background color. */
1601 if (pixel
== f
->output_data
.x
->background_pixel
)
1603 pixel
= f
->output_data
.x
->mouse_pixel
;
1604 if (pixel
== fore_pixel
)
1605 fore_pixel
= f
->output_data
.x
->background_pixel
;
1608 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1609 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1611 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1612 f
->output_data
.x
->cursor_pixel
= pixel
;
1614 if (FRAME_X_WINDOW (f
) != 0)
1617 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1618 f
->output_data
.x
->cursor_pixel
);
1619 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1623 if (FRAME_VISIBLE_P (f
))
1625 x_update_cursor (f
, 0);
1626 x_update_cursor (f
, 1);
1630 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1633 /* Set the border-color of frame F to value described by ARG.
1634 ARG can be a string naming a color.
1635 The border-color is used for the border that is drawn by the X server.
1636 Note that this does not fully take effect if done before
1637 F has an x-window; it must be redone when the window is created.
1639 Note: this is done in two routines because of the way X10 works.
1641 Note: under X11, this is normally the province of the window manager,
1642 and so emacs' border colors may be overridden. */
1645 x_set_border_color (f
, arg
, oldval
)
1647 Lisp_Object arg
, oldval
;
1651 CHECK_STRING (arg
, 0);
1652 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1653 x_set_border_pixel (f
, pix
);
1654 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1657 /* Set the border-color of frame F to pixel value PIX.
1658 Note that this does not fully take effect if done before
1659 F has an x-window. */
1662 x_set_border_pixel (f
, pix
)
1666 unload_color (f
, f
->output_data
.x
->border_pixel
);
1667 f
->output_data
.x
->border_pixel
= pix
;
1669 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1672 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1673 (unsigned long)pix
);
1676 if (FRAME_VISIBLE_P (f
))
1682 x_set_cursor_type (f
, arg
, oldval
)
1684 Lisp_Object arg
, oldval
;
1688 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1689 f
->output_data
.x
->cursor_width
= 2;
1691 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1692 && INTEGERP (XCDR (arg
)))
1694 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1695 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1698 /* Treat anything unknown as "box cursor".
1699 It was bad to signal an error; people have trouble fixing
1700 .Xdefaults with Emacs, when it has something bad in it. */
1701 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1703 /* Make sure the cursor gets redrawn. This is overkill, but how
1704 often do people change cursor types? */
1705 update_mode_lines
++;
1709 x_set_icon_type (f
, arg
, oldval
)
1711 Lisp_Object arg
, oldval
;
1717 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1720 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1725 result
= x_text_icon (f
,
1726 (char *) XSTRING ((!NILP (f
->icon_name
)
1730 result
= x_bitmap_icon (f
, arg
);
1735 error ("No icon window available");
1738 XFlush (FRAME_X_DISPLAY (f
));
1742 /* Return non-nil if frame F wants a bitmap icon. */
1750 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1758 x_set_icon_name (f
, arg
, oldval
)
1760 Lisp_Object arg
, oldval
;
1766 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1769 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1774 if (f
->output_data
.x
->icon_bitmap
!= 0)
1779 result
= x_text_icon (f
,
1780 (char *) XSTRING ((!NILP (f
->icon_name
)
1789 error ("No icon window available");
1792 XFlush (FRAME_X_DISPLAY (f
));
1797 x_set_font (f
, arg
, oldval
)
1799 Lisp_Object arg
, oldval
;
1802 Lisp_Object fontset_name
;
1805 CHECK_STRING (arg
, 1);
1807 fontset_name
= Fquery_fontset (arg
, Qnil
);
1810 result
= (STRINGP (fontset_name
)
1811 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1812 : x_new_font (f
, XSTRING (arg
)->data
));
1815 if (EQ (result
, Qnil
))
1816 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1817 else if (EQ (result
, Qt
))
1818 error ("The characters of the given font have varying widths");
1819 else if (STRINGP (result
))
1821 store_frame_param (f
, Qfont
, result
);
1822 recompute_basic_faces (f
);
1827 do_pending_window_change (0);
1829 /* Don't call `face-set-after-frame-default' when faces haven't been
1830 initialized yet. This is the case when called from
1831 Fx_create_frame. In that case, the X widget or window doesn't
1832 exist either, and we can end up in x_report_frame_params with a
1833 null widget which gives a segfault. */
1834 if (FRAME_FACE_CACHE (f
))
1836 XSETFRAME (frame
, f
);
1837 call1 (Qface_set_after_frame_default
, frame
);
1842 x_set_border_width (f
, arg
, oldval
)
1844 Lisp_Object arg
, oldval
;
1846 CHECK_NUMBER (arg
, 0);
1848 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1851 if (FRAME_X_WINDOW (f
) != 0)
1852 error ("Cannot change the border width of a window");
1854 f
->output_data
.x
->border_width
= XINT (arg
);
1858 x_set_internal_border_width (f
, arg
, oldval
)
1860 Lisp_Object arg
, oldval
;
1862 int old
= f
->output_data
.x
->internal_border_width
;
1864 CHECK_NUMBER (arg
, 0);
1865 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1866 if (f
->output_data
.x
->internal_border_width
< 0)
1867 f
->output_data
.x
->internal_border_width
= 0;
1869 #ifdef USE_X_TOOLKIT
1870 if (f
->output_data
.x
->edit_widget
)
1871 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1874 if (f
->output_data
.x
->internal_border_width
== old
)
1877 if (FRAME_X_WINDOW (f
) != 0)
1879 x_set_window_size (f
, 0, f
->width
, f
->height
);
1880 SET_FRAME_GARBAGED (f
);
1881 do_pending_window_change (0);
1886 x_set_visibility (f
, value
, oldval
)
1888 Lisp_Object value
, oldval
;
1891 XSETFRAME (frame
, f
);
1894 Fmake_frame_invisible (frame
, Qt
);
1895 else if (EQ (value
, Qicon
))
1896 Ficonify_frame (frame
);
1898 Fmake_frame_visible (frame
);
1902 x_set_menu_bar_lines_1 (window
, n
)
1906 struct window
*w
= XWINDOW (window
);
1908 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1909 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1911 /* Handle just the top child in a vertical split. */
1912 if (!NILP (w
->vchild
))
1913 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1915 /* Adjust all children in a horizontal split. */
1916 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1918 w
= XWINDOW (window
);
1919 x_set_menu_bar_lines_1 (window
, n
);
1924 x_set_menu_bar_lines (f
, value
, oldval
)
1926 Lisp_Object value
, oldval
;
1929 #ifndef USE_X_TOOLKIT
1930 int olines
= FRAME_MENU_BAR_LINES (f
);
1933 /* Right now, menu bars don't work properly in minibuf-only frames;
1934 most of the commands try to apply themselves to the minibuffer
1935 frame itself, and get an error because you can't switch buffers
1936 in or split the minibuffer window. */
1937 if (FRAME_MINIBUF_ONLY_P (f
))
1940 if (INTEGERP (value
))
1941 nlines
= XINT (value
);
1945 /* Make sure we redisplay all windows in this frame. */
1946 windows_or_buffers_changed
++;
1948 #ifdef USE_X_TOOLKIT
1949 FRAME_MENU_BAR_LINES (f
) = 0;
1952 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1953 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1954 /* Make sure next redisplay shows the menu bar. */
1955 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1959 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1960 free_frame_menubar (f
);
1961 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1963 f
->output_data
.x
->menubar_widget
= 0;
1965 #else /* not USE_X_TOOLKIT */
1966 FRAME_MENU_BAR_LINES (f
) = nlines
;
1967 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1968 #endif /* not USE_X_TOOLKIT */
1973 /* Set the number of lines used for the tool bar of frame F to VALUE.
1974 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1975 is the old number of tool bar lines. This function changes the
1976 height of all windows on frame F to match the new tool bar height.
1977 The frame's height doesn't change. */
1980 x_set_tool_bar_lines (f
, value
, oldval
)
1982 Lisp_Object value
, oldval
;
1986 /* Use VALUE only if an integer >= 0. */
1987 if (INTEGERP (value
) && XINT (value
) >= 0)
1988 nlines
= XFASTINT (value
);
1992 /* Make sure we redisplay all windows in this frame. */
1993 ++windows_or_buffers_changed
;
1995 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1996 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1997 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
2002 /* Set the foreground color for scroll bars on frame F to VALUE.
2003 VALUE should be a string, a color name. If it isn't a string or
2004 isn't a valid color name, do nothing. OLDVAL is the old value of
2005 the frame parameter. */
2008 x_set_scroll_bar_foreground (f
, value
, oldval
)
2010 Lisp_Object value
, oldval
;
2012 unsigned long pixel
;
2014 if (STRINGP (value
))
2015 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2019 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2020 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2022 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2023 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2025 /* Remove all scroll bars because they have wrong colors. */
2026 if (condemn_scroll_bars_hook
)
2027 (*condemn_scroll_bars_hook
) (f
);
2028 if (judge_scroll_bars_hook
)
2029 (*judge_scroll_bars_hook
) (f
);
2031 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2037 /* Set the background color for scroll bars on frame F to VALUE VALUE
2038 should be a string, a color name. If it isn't a string or isn't a
2039 valid color name, do nothing. OLDVAL is the old value of the frame
2043 x_set_scroll_bar_background (f
, value
, oldval
)
2045 Lisp_Object value
, oldval
;
2047 unsigned long pixel
;
2049 if (STRINGP (value
))
2050 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2054 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2055 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2057 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2058 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2060 /* Remove all scroll bars because they have wrong colors. */
2061 if (condemn_scroll_bars_hook
)
2062 (*condemn_scroll_bars_hook
) (f
);
2063 if (judge_scroll_bars_hook
)
2064 (*judge_scroll_bars_hook
) (f
);
2066 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2072 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2075 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2076 name; if NAME is a string, set F's name to NAME and set
2077 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2079 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2080 suggesting a new name, which lisp code should override; if
2081 F->explicit_name is set, ignore the new name; otherwise, set it. */
2084 x_set_name (f
, name
, explicit)
2089 /* Make sure that requests from lisp code override requests from
2090 Emacs redisplay code. */
2093 /* If we're switching from explicit to implicit, we had better
2094 update the mode lines and thereby update the title. */
2095 if (f
->explicit_name
&& NILP (name
))
2096 update_mode_lines
= 1;
2098 f
->explicit_name
= ! NILP (name
);
2100 else if (f
->explicit_name
)
2103 /* If NAME is nil, set the name to the x_id_name. */
2106 /* Check for no change needed in this very common case
2107 before we do any consing. */
2108 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2109 XSTRING (f
->name
)->data
))
2111 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2114 CHECK_STRING (name
, 0);
2116 /* Don't change the name if it's already NAME. */
2117 if (! NILP (Fstring_equal (name
, f
->name
)))
2122 /* For setting the frame title, the title parameter should override
2123 the name parameter. */
2124 if (! NILP (f
->title
))
2127 if (FRAME_X_WINDOW (f
))
2132 XTextProperty text
, icon
;
2133 Lisp_Object icon_name
;
2135 text
.value
= XSTRING (name
)->data
;
2136 text
.encoding
= XA_STRING
;
2138 text
.nitems
= STRING_BYTES (XSTRING (name
));
2140 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2142 icon
.value
= XSTRING (icon_name
)->data
;
2143 icon
.encoding
= XA_STRING
;
2145 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2146 #ifdef USE_X_TOOLKIT
2147 XSetWMName (FRAME_X_DISPLAY (f
),
2148 XtWindow (f
->output_data
.x
->widget
), &text
);
2149 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2151 #else /* not USE_X_TOOLKIT */
2152 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2153 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2154 #endif /* not USE_X_TOOLKIT */
2156 #else /* not HAVE_X11R4 */
2157 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2158 XSTRING (name
)->data
);
2159 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2160 XSTRING (name
)->data
);
2161 #endif /* not HAVE_X11R4 */
2166 /* This function should be called when the user's lisp code has
2167 specified a name for the frame; the name will override any set by the
2170 x_explicitly_set_name (f
, arg
, oldval
)
2172 Lisp_Object arg
, oldval
;
2174 x_set_name (f
, arg
, 1);
2177 /* This function should be called by Emacs redisplay code to set the
2178 name; names set this way will never override names set by the user's
2181 x_implicitly_set_name (f
, arg
, oldval
)
2183 Lisp_Object arg
, oldval
;
2185 x_set_name (f
, arg
, 0);
2188 /* Change the title of frame F to NAME.
2189 If NAME is nil, use the frame name as the title.
2191 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2192 name; if NAME is a string, set F's name to NAME and set
2193 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2195 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2196 suggesting a new name, which lisp code should override; if
2197 F->explicit_name is set, ignore the new name; otherwise, set it. */
2200 x_set_title (f
, name
, old_name
)
2202 Lisp_Object name
, old_name
;
2204 /* Don't change the title if it's already NAME. */
2205 if (EQ (name
, f
->title
))
2208 update_mode_lines
= 1;
2215 CHECK_STRING (name
, 0);
2217 if (FRAME_X_WINDOW (f
))
2222 XTextProperty text
, icon
;
2223 Lisp_Object icon_name
;
2225 text
.value
= XSTRING (name
)->data
;
2226 text
.encoding
= XA_STRING
;
2228 text
.nitems
= STRING_BYTES (XSTRING (name
));
2230 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2232 icon
.value
= XSTRING (icon_name
)->data
;
2233 icon
.encoding
= XA_STRING
;
2235 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2236 #ifdef USE_X_TOOLKIT
2237 XSetWMName (FRAME_X_DISPLAY (f
),
2238 XtWindow (f
->output_data
.x
->widget
), &text
);
2239 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2241 #else /* not USE_X_TOOLKIT */
2242 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2243 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2244 #endif /* not USE_X_TOOLKIT */
2246 #else /* not HAVE_X11R4 */
2247 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2248 XSTRING (name
)->data
);
2249 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2250 XSTRING (name
)->data
);
2251 #endif /* not HAVE_X11R4 */
2257 x_set_autoraise (f
, arg
, oldval
)
2259 Lisp_Object arg
, oldval
;
2261 f
->auto_raise
= !EQ (Qnil
, arg
);
2265 x_set_autolower (f
, arg
, oldval
)
2267 Lisp_Object arg
, oldval
;
2269 f
->auto_lower
= !EQ (Qnil
, arg
);
2273 x_set_unsplittable (f
, arg
, oldval
)
2275 Lisp_Object arg
, oldval
;
2277 f
->no_split
= !NILP (arg
);
2281 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2283 Lisp_Object arg
, oldval
;
2285 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2286 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2287 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2288 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2290 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2292 ? vertical_scroll_bar_none
2294 ? vertical_scroll_bar_right
2295 : vertical_scroll_bar_left
);
2297 /* We set this parameter before creating the X window for the
2298 frame, so we can get the geometry right from the start.
2299 However, if the window hasn't been created yet, we shouldn't
2300 call x_set_window_size. */
2301 if (FRAME_X_WINDOW (f
))
2302 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2303 do_pending_window_change (0);
2308 x_set_scroll_bar_width (f
, arg
, oldval
)
2310 Lisp_Object arg
, oldval
;
2312 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2316 #ifdef USE_TOOLKIT_SCROLL_BARS
2317 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2318 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2319 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2320 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2322 /* Make the actual width at least 14 pixels and a multiple of a
2324 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2326 /* Use all of that space (aside from required margins) for the
2328 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2331 if (FRAME_X_WINDOW (f
))
2332 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2333 do_pending_window_change (0);
2335 else if (INTEGERP (arg
) && XINT (arg
) > 0
2336 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2338 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2339 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2341 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2342 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2343 if (FRAME_X_WINDOW (f
))
2344 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2347 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2348 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2349 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2354 /* Subroutines of creating an X frame. */
2356 /* Make sure that Vx_resource_name is set to a reasonable value.
2357 Fix it up, or set it to `emacs' if it is too hopeless. */
2360 validate_x_resource_name ()
2363 /* Number of valid characters in the resource name. */
2365 /* Number of invalid characters in the resource name. */
2370 if (!STRINGP (Vx_resource_class
))
2371 Vx_resource_class
= build_string (EMACS_CLASS
);
2373 if (STRINGP (Vx_resource_name
))
2375 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2378 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2380 /* Only letters, digits, - and _ are valid in resource names.
2381 Count the valid characters and count the invalid ones. */
2382 for (i
= 0; i
< len
; i
++)
2385 if (! ((c
>= 'a' && c
<= 'z')
2386 || (c
>= 'A' && c
<= 'Z')
2387 || (c
>= '0' && c
<= '9')
2388 || c
== '-' || c
== '_'))
2395 /* Not a string => completely invalid. */
2396 bad_count
= 5, good_count
= 0;
2398 /* If name is valid already, return. */
2402 /* If name is entirely invalid, or nearly so, use `emacs'. */
2404 || (good_count
== 1 && bad_count
> 0))
2406 Vx_resource_name
= build_string ("emacs");
2410 /* Name is partly valid. Copy it and replace the invalid characters
2411 with underscores. */
2413 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2415 for (i
= 0; i
< len
; i
++)
2417 int c
= XSTRING (new)->data
[i
];
2418 if (! ((c
>= 'a' && c
<= 'z')
2419 || (c
>= 'A' && c
<= 'Z')
2420 || (c
>= '0' && c
<= '9')
2421 || c
== '-' || c
== '_'))
2422 XSTRING (new)->data
[i
] = '_';
2427 extern char *x_get_string_resource ();
2429 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2430 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2431 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2432 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2433 the name specified by the `-name' or `-rn' command-line arguments.\n\
2435 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2436 class, respectively. You must specify both of them or neither.\n\
2437 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2438 and the class is `Emacs.CLASS.SUBCLASS'.")
2439 (attribute
, class, component
, subclass
)
2440 Lisp_Object attribute
, class, component
, subclass
;
2442 register char *value
;
2448 CHECK_STRING (attribute
, 0);
2449 CHECK_STRING (class, 0);
2451 if (!NILP (component
))
2452 CHECK_STRING (component
, 1);
2453 if (!NILP (subclass
))
2454 CHECK_STRING (subclass
, 2);
2455 if (NILP (component
) != NILP (subclass
))
2456 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2458 validate_x_resource_name ();
2460 /* Allocate space for the components, the dots which separate them,
2461 and the final '\0'. Make them big enough for the worst case. */
2462 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2463 + (STRINGP (component
)
2464 ? STRING_BYTES (XSTRING (component
)) : 0)
2465 + STRING_BYTES (XSTRING (attribute
))
2468 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2469 + STRING_BYTES (XSTRING (class))
2470 + (STRINGP (subclass
)
2471 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2474 /* Start with emacs.FRAMENAME for the name (the specific one)
2475 and with `Emacs' for the class key (the general one). */
2476 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2477 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2479 strcat (class_key
, ".");
2480 strcat (class_key
, XSTRING (class)->data
);
2482 if (!NILP (component
))
2484 strcat (class_key
, ".");
2485 strcat (class_key
, XSTRING (subclass
)->data
);
2487 strcat (name_key
, ".");
2488 strcat (name_key
, XSTRING (component
)->data
);
2491 strcat (name_key
, ".");
2492 strcat (name_key
, XSTRING (attribute
)->data
);
2494 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2495 name_key
, class_key
);
2497 if (value
!= (char *) 0)
2498 return build_string (value
);
2503 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2506 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2507 struct x_display_info
*dpyinfo
;
2508 Lisp_Object attribute
, class, component
, subclass
;
2510 register char *value
;
2516 CHECK_STRING (attribute
, 0);
2517 CHECK_STRING (class, 0);
2519 if (!NILP (component
))
2520 CHECK_STRING (component
, 1);
2521 if (!NILP (subclass
))
2522 CHECK_STRING (subclass
, 2);
2523 if (NILP (component
) != NILP (subclass
))
2524 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2526 validate_x_resource_name ();
2528 /* Allocate space for the components, the dots which separate them,
2529 and the final '\0'. Make them big enough for the worst case. */
2530 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2531 + (STRINGP (component
)
2532 ? STRING_BYTES (XSTRING (component
)) : 0)
2533 + STRING_BYTES (XSTRING (attribute
))
2536 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2537 + STRING_BYTES (XSTRING (class))
2538 + (STRINGP (subclass
)
2539 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2542 /* Start with emacs.FRAMENAME for the name (the specific one)
2543 and with `Emacs' for the class key (the general one). */
2544 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2545 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2547 strcat (class_key
, ".");
2548 strcat (class_key
, XSTRING (class)->data
);
2550 if (!NILP (component
))
2552 strcat (class_key
, ".");
2553 strcat (class_key
, XSTRING (subclass
)->data
);
2555 strcat (name_key
, ".");
2556 strcat (name_key
, XSTRING (component
)->data
);
2559 strcat (name_key
, ".");
2560 strcat (name_key
, XSTRING (attribute
)->data
);
2562 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2564 if (value
!= (char *) 0)
2565 return build_string (value
);
2570 /* Used when C code wants a resource value. */
2573 x_get_resource_string (attribute
, class)
2574 char *attribute
, *class;
2578 struct frame
*sf
= SELECTED_FRAME ();
2580 /* Allocate space for the components, the dots which separate them,
2581 and the final '\0'. */
2582 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2583 + strlen (attribute
) + 2);
2584 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2585 + strlen (class) + 2);
2587 sprintf (name_key
, "%s.%s",
2588 XSTRING (Vinvocation_name
)->data
,
2590 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2592 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2593 name_key
, class_key
);
2596 /* Types we might convert a resource string into. */
2606 /* Return the value of parameter PARAM.
2608 First search ALIST, then Vdefault_frame_alist, then the X defaults
2609 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2611 Convert the resource to the type specified by desired_type.
2613 If no default is specified, return Qunbound. If you call
2614 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2615 and don't let it get stored in any Lisp-visible variables! */
2618 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2619 struct x_display_info
*dpyinfo
;
2620 Lisp_Object alist
, param
;
2623 enum resource_types type
;
2625 register Lisp_Object tem
;
2627 tem
= Fassq (param
, alist
);
2629 tem
= Fassq (param
, Vdefault_frame_alist
);
2635 tem
= display_x_get_resource (dpyinfo
,
2636 build_string (attribute
),
2637 build_string (class),
2645 case RES_TYPE_NUMBER
:
2646 return make_number (atoi (XSTRING (tem
)->data
));
2648 case RES_TYPE_FLOAT
:
2649 return make_float (atof (XSTRING (tem
)->data
));
2651 case RES_TYPE_BOOLEAN
:
2652 tem
= Fdowncase (tem
);
2653 if (!strcmp (XSTRING (tem
)->data
, "on")
2654 || !strcmp (XSTRING (tem
)->data
, "true"))
2659 case RES_TYPE_STRING
:
2662 case RES_TYPE_SYMBOL
:
2663 /* As a special case, we map the values `true' and `on'
2664 to Qt, and `false' and `off' to Qnil. */
2667 lower
= Fdowncase (tem
);
2668 if (!strcmp (XSTRING (lower
)->data
, "on")
2669 || !strcmp (XSTRING (lower
)->data
, "true"))
2671 else if (!strcmp (XSTRING (lower
)->data
, "off")
2672 || !strcmp (XSTRING (lower
)->data
, "false"))
2675 return Fintern (tem
, Qnil
);
2688 /* Like x_get_arg, but also record the value in f->param_alist. */
2691 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2693 Lisp_Object alist
, param
;
2696 enum resource_types type
;
2700 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2701 attribute
, class, type
);
2703 store_frame_param (f
, param
, value
);
2708 /* Record in frame F the specified or default value according to ALIST
2709 of the parameter named PROP (a Lisp symbol).
2710 If no value is specified for PROP, look for an X default for XPROP
2711 on the frame named NAME.
2712 If that is not found either, use the value DEFLT. */
2715 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2722 enum resource_types type
;
2726 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2727 if (EQ (tem
, Qunbound
))
2729 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2734 /* Record in frame F the specified or default value according to ALIST
2735 of the parameter named PROP (a Lisp symbol). If no value is
2736 specified for PROP, look for an X default for XPROP on the frame
2737 named NAME. If that is not found either, use the value DEFLT. */
2740 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2749 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2752 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2753 if (EQ (tem
, Qunbound
))
2755 #ifdef USE_TOOLKIT_SCROLL_BARS
2757 /* See if an X resource for the scroll bar color has been
2759 tem
= display_x_get_resource (dpyinfo
,
2760 build_string (foreground_p
2764 build_string ("verticalScrollBar"),
2768 /* If nothing has been specified, scroll bars will use a
2769 toolkit-dependent default. Because these defaults are
2770 difficult to get at without actually creating a scroll
2771 bar, use nil to indicate that no color has been
2776 #else /* not USE_TOOLKIT_SCROLL_BARS */
2780 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2783 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2789 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2790 "Parse an X-style geometry string STRING.\n\
2791 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2792 The properties returned may include `top', `left', `height', and `width'.\n\
2793 The value of `left' or `top' may be an integer,\n\
2794 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2795 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2800 unsigned int width
, height
;
2803 CHECK_STRING (string
, 0);
2805 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2806 &x
, &y
, &width
, &height
);
2809 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2810 error ("Must specify both x and y position, or neither");
2814 if (geometry
& XValue
)
2816 Lisp_Object element
;
2818 if (x
>= 0 && (geometry
& XNegative
))
2819 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2820 else if (x
< 0 && ! (geometry
& XNegative
))
2821 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2823 element
= Fcons (Qleft
, make_number (x
));
2824 result
= Fcons (element
, result
);
2827 if (geometry
& YValue
)
2829 Lisp_Object element
;
2831 if (y
>= 0 && (geometry
& YNegative
))
2832 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2833 else if (y
< 0 && ! (geometry
& YNegative
))
2834 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2836 element
= Fcons (Qtop
, make_number (y
));
2837 result
= Fcons (element
, result
);
2840 if (geometry
& WidthValue
)
2841 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2842 if (geometry
& HeightValue
)
2843 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2848 /* Calculate the desired size and position of this window,
2849 and return the flags saying which aspects were specified.
2851 This function does not make the coordinates positive. */
2853 #define DEFAULT_ROWS 40
2854 #define DEFAULT_COLS 80
2857 x_figure_window_size (f
, parms
)
2861 register Lisp_Object tem0
, tem1
, tem2
;
2862 long window_prompting
= 0;
2863 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2865 /* Default values if we fall through.
2866 Actually, if that happens we should get
2867 window manager prompting. */
2868 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2869 f
->height
= DEFAULT_ROWS
;
2870 /* Window managers expect that if program-specified
2871 positions are not (0,0), they're intentional, not defaults. */
2872 f
->output_data
.x
->top_pos
= 0;
2873 f
->output_data
.x
->left_pos
= 0;
2875 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2876 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2877 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2878 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2880 if (!EQ (tem0
, Qunbound
))
2882 CHECK_NUMBER (tem0
, 0);
2883 f
->height
= XINT (tem0
);
2885 if (!EQ (tem1
, Qunbound
))
2887 CHECK_NUMBER (tem1
, 0);
2888 SET_FRAME_WIDTH (f
, XINT (tem1
));
2890 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2891 window_prompting
|= USSize
;
2893 window_prompting
|= PSize
;
2896 f
->output_data
.x
->vertical_scroll_bar_extra
2897 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2899 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2900 f
->output_data
.x
->flags_areas_extra
2901 = FRAME_FLAGS_AREA_WIDTH (f
);
2902 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2903 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2905 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2906 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2907 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2908 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2910 if (EQ (tem0
, Qminus
))
2912 f
->output_data
.x
->top_pos
= 0;
2913 window_prompting
|= YNegative
;
2915 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2916 && CONSP (XCDR (tem0
))
2917 && INTEGERP (XCAR (XCDR (tem0
))))
2919 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2920 window_prompting
|= YNegative
;
2922 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2923 && CONSP (XCDR (tem0
))
2924 && INTEGERP (XCAR (XCDR (tem0
))))
2926 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2928 else if (EQ (tem0
, Qunbound
))
2929 f
->output_data
.x
->top_pos
= 0;
2932 CHECK_NUMBER (tem0
, 0);
2933 f
->output_data
.x
->top_pos
= XINT (tem0
);
2934 if (f
->output_data
.x
->top_pos
< 0)
2935 window_prompting
|= YNegative
;
2938 if (EQ (tem1
, Qminus
))
2940 f
->output_data
.x
->left_pos
= 0;
2941 window_prompting
|= XNegative
;
2943 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2944 && CONSP (XCDR (tem1
))
2945 && INTEGERP (XCAR (XCDR (tem1
))))
2947 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2948 window_prompting
|= XNegative
;
2950 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2951 && CONSP (XCDR (tem1
))
2952 && INTEGERP (XCAR (XCDR (tem1
))))
2954 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2956 else if (EQ (tem1
, Qunbound
))
2957 f
->output_data
.x
->left_pos
= 0;
2960 CHECK_NUMBER (tem1
, 0);
2961 f
->output_data
.x
->left_pos
= XINT (tem1
);
2962 if (f
->output_data
.x
->left_pos
< 0)
2963 window_prompting
|= XNegative
;
2966 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2967 window_prompting
|= USPosition
;
2969 window_prompting
|= PPosition
;
2972 return window_prompting
;
2975 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2978 XSetWMProtocols (dpy
, w
, protocols
, count
)
2985 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2986 if (prop
== None
) return False
;
2987 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2988 (unsigned char *) protocols
, count
);
2991 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2993 #ifdef USE_X_TOOLKIT
2995 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2996 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2997 already be present because of the toolkit (Motif adds some of them,
2998 for example, but Xt doesn't). */
3001 hack_wm_protocols (f
, widget
)
3005 Display
*dpy
= XtDisplay (widget
);
3006 Window w
= XtWindow (widget
);
3007 int need_delete
= 1;
3013 Atom type
, *atoms
= 0;
3015 unsigned long nitems
= 0;
3016 unsigned long bytes_after
;
3018 if ((XGetWindowProperty (dpy
, w
,
3019 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3020 (long)0, (long)100, False
, XA_ATOM
,
3021 &type
, &format
, &nitems
, &bytes_after
,
3022 (unsigned char **) &atoms
)
3024 && format
== 32 && type
== XA_ATOM
)
3028 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3030 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3032 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3035 if (atoms
) XFree ((char *) atoms
);
3041 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3043 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3045 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3047 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3048 XA_ATOM
, 32, PropModeAppend
,
3049 (unsigned char *) props
, count
);
3055 #ifdef USE_X_TOOLKIT
3057 /* Create and set up the X widget for frame F. */
3060 x_window (f
, window_prompting
, minibuffer_only
)
3062 long window_prompting
;
3063 int minibuffer_only
;
3065 XClassHint class_hints
;
3066 XSetWindowAttributes attributes
;
3067 unsigned long attribute_mask
;
3069 Widget shell_widget
;
3071 Widget frame_widget
;
3077 /* Use the resource name as the top-level widget name
3078 for looking up resources. Make a non-Lisp copy
3079 for the window manager, so GC relocation won't bother it.
3081 Elsewhere we specify the window name for the window manager. */
3084 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3085 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3086 strcpy (f
->namebuf
, str
);
3090 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3091 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3092 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3093 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3094 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3095 applicationShellWidgetClass
,
3096 FRAME_X_DISPLAY (f
), al
, ac
);
3098 f
->output_data
.x
->widget
= shell_widget
;
3099 /* maybe_set_screen_title_format (shell_widget); */
3101 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3102 (widget_value
*) NULL
,
3103 shell_widget
, False
,
3106 (lw_callback
) NULL
);
3108 f
->output_data
.x
->column_widget
= pane_widget
;
3110 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3111 the emacs screen when changing menubar. This reduces flickering. */
3114 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3115 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3116 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3117 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3118 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3119 frame_widget
= XtCreateWidget (f
->namebuf
,
3121 pane_widget
, al
, ac
);
3123 f
->output_data
.x
->edit_widget
= frame_widget
;
3125 XtManageChild (frame_widget
);
3127 /* Do some needed geometry management. */
3130 char *tem
, shell_position
[32];
3133 int extra_borders
= 0;
3135 = (f
->output_data
.x
->menubar_widget
3136 ? (f
->output_data
.x
->menubar_widget
->core
.height
3137 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3140 #if 0 /* Experimentally, we now get the right results
3141 for -geometry -0-0 without this. 24 Aug 96, rms. */
3142 if (FRAME_EXTERNAL_MENU_BAR (f
))
3145 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3146 menubar_size
+= ibw
;
3150 f
->output_data
.x
->menubar_height
= menubar_size
;
3153 /* Motif seems to need this amount added to the sizes
3154 specified for the shell widget. The Athena/Lucid widgets don't.
3155 Both conclusions reached experimentally. -- rms. */
3156 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3157 &extra_borders
, NULL
);
3161 /* Convert our geometry parameters into a geometry string
3163 Note that we do not specify here whether the position
3164 is a user-specified or program-specified one.
3165 We pass that information later, in x_wm_set_size_hints. */
3167 int left
= f
->output_data
.x
->left_pos
;
3168 int xneg
= window_prompting
& XNegative
;
3169 int top
= f
->output_data
.x
->top_pos
;
3170 int yneg
= window_prompting
& YNegative
;
3176 if (window_prompting
& USPosition
)
3177 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3178 PIXEL_WIDTH (f
) + extra_borders
,
3179 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3180 (xneg
? '-' : '+'), left
,
3181 (yneg
? '-' : '+'), top
);
3183 sprintf (shell_position
, "=%dx%d",
3184 PIXEL_WIDTH (f
) + extra_borders
,
3185 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3188 len
= strlen (shell_position
) + 1;
3189 /* We don't free this because we don't know whether
3190 it is safe to free it while the frame exists.
3191 It isn't worth the trouble of arranging to free it
3192 when the frame is deleted. */
3193 tem
= (char *) xmalloc (len
);
3194 strncpy (tem
, shell_position
, len
);
3195 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3196 XtSetValues (shell_widget
, al
, ac
);
3199 XtManageChild (pane_widget
);
3200 XtRealizeWidget (shell_widget
);
3202 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3204 validate_x_resource_name ();
3206 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3207 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3208 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3211 #ifndef X_I18N_INHIBITED
3216 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
3220 xic
= XCreateIC (xim
,
3221 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3222 XNClientWindow
, FRAME_X_WINDOW(f
),
3223 XNFocusWindow
, FRAME_X_WINDOW(f
),
3232 FRAME_XIM (f
) = xim
;
3233 FRAME_XIC (f
) = xic
;
3235 #else /* X_I18N_INHIBITED */
3238 #endif /* X_I18N_INHIBITED */
3239 #endif /* HAVE_X_I18N */
3241 f
->output_data
.x
->wm_hints
.input
= True
;
3242 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3243 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3244 &f
->output_data
.x
->wm_hints
);
3246 hack_wm_protocols (f
, shell_widget
);
3249 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3252 /* Do a stupid property change to force the server to generate a
3253 PropertyNotify event so that the event_stream server timestamp will
3254 be initialized to something relevant to the time we created the window.
3256 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3257 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3258 XA_ATOM
, 32, PropModeAppend
,
3259 (unsigned char*) NULL
, 0);
3261 /* Make all the standard events reach the Emacs frame. */
3262 attributes
.event_mask
= STANDARD_EVENT_SET
;
3263 attribute_mask
= CWEventMask
;
3264 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3265 attribute_mask
, &attributes
);
3267 XtMapWidget (frame_widget
);
3269 /* x_set_name normally ignores requests to set the name if the
3270 requested name is the same as the current name. This is the one
3271 place where that assumption isn't correct; f->name is set, but
3272 the X server hasn't been told. */
3275 int explicit = f
->explicit_name
;
3277 f
->explicit_name
= 0;
3280 x_set_name (f
, name
, explicit);
3283 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3284 f
->output_data
.x
->text_cursor
);
3288 /* This is a no-op, except under Motif. Make sure main areas are
3289 set to something reasonable, in case we get an error later. */
3290 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3293 #else /* not USE_X_TOOLKIT */
3295 /* Create and set up the X window for frame F. */
3302 XClassHint class_hints
;
3303 XSetWindowAttributes attributes
;
3304 unsigned long attribute_mask
;
3306 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3307 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3308 attributes
.bit_gravity
= StaticGravity
;
3309 attributes
.backing_store
= NotUseful
;
3310 attributes
.save_under
= True
;
3311 attributes
.event_mask
= STANDARD_EVENT_SET
;
3312 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3314 | CWBackingStore
| CWSaveUnder
3320 = XCreateWindow (FRAME_X_DISPLAY (f
),
3321 f
->output_data
.x
->parent_desc
,
3322 f
->output_data
.x
->left_pos
,
3323 f
->output_data
.x
->top_pos
,
3324 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3325 f
->output_data
.x
->border_width
,
3326 CopyFromParent
, /* depth */
3327 InputOutput
, /* class */
3328 FRAME_X_DISPLAY_INFO (f
)->visual
,
3329 attribute_mask
, &attributes
);
3331 #ifndef X_I18N_INHIBITED
3336 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3340 xic
= XCreateIC (xim
,
3341 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3342 XNClientWindow
, FRAME_X_WINDOW(f
),
3343 XNFocusWindow
, FRAME_X_WINDOW(f
),
3353 FRAME_XIM (f
) = xim
;
3354 FRAME_XIC (f
) = xic
;
3356 #else /* X_I18N_INHIBITED */
3359 #endif /* X_I18N_INHIBITED */
3360 #endif /* HAVE_X_I18N */
3362 validate_x_resource_name ();
3364 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3365 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3366 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3368 /* The menubar is part of the ordinary display;
3369 it does not count in addition to the height of the window. */
3370 f
->output_data
.x
->menubar_height
= 0;
3372 /* This indicates that we use the "Passive Input" input model.
3373 Unless we do this, we don't get the Focus{In,Out} events that we
3374 need to draw the cursor correctly. Accursed bureaucrats.
3375 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3377 f
->output_data
.x
->wm_hints
.input
= True
;
3378 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3379 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3380 &f
->output_data
.x
->wm_hints
);
3381 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3383 /* Request "save yourself" and "delete window" commands from wm. */
3386 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3387 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3388 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3391 /* x_set_name normally ignores requests to set the name if the
3392 requested name is the same as the current name. This is the one
3393 place where that assumption isn't correct; f->name is set, but
3394 the X server hasn't been told. */
3397 int explicit = f
->explicit_name
;
3399 f
->explicit_name
= 0;
3402 x_set_name (f
, name
, explicit);
3405 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3406 f
->output_data
.x
->text_cursor
);
3410 if (FRAME_X_WINDOW (f
) == 0)
3411 error ("Unable to create window");
3414 #endif /* not USE_X_TOOLKIT */
3416 /* Handle the icon stuff for this window. Perhaps later we might
3417 want an x_set_icon_position which can be called interactively as
3425 Lisp_Object icon_x
, icon_y
;
3426 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3428 /* Set the position of the icon. Note that twm groups all
3429 icons in an icon window. */
3430 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3431 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3432 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3434 CHECK_NUMBER (icon_x
, 0);
3435 CHECK_NUMBER (icon_y
, 0);
3437 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3438 error ("Both left and top icon corners of icon must be specified");
3442 if (! EQ (icon_x
, Qunbound
))
3443 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3445 /* Start up iconic or window? */
3446 x_wm_set_window_state
3447 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3452 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3459 /* Make the GC's needed for this window, setting the
3460 background, border and mouse colors; also create the
3461 mouse cursor and the gray border tile. */
3463 static char cursor_bits
[] =
3465 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3466 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3467 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3468 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3475 XGCValues gc_values
;
3479 /* Create the GC's of this frame.
3480 Note that many default values are used. */
3483 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3484 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3485 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3486 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3487 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3489 GCLineWidth
| GCFont
3490 | GCForeground
| GCBackground
,
3493 /* Reverse video style. */
3494 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3495 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3496 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3498 GCFont
| GCForeground
| GCBackground
3502 /* Cursor has cursor-color background, background-color foreground. */
3503 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3504 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3505 gc_values
.fill_style
= FillOpaqueStippled
;
3507 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3508 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3509 cursor_bits
, 16, 16);
3510 f
->output_data
.x
->cursor_gc
3511 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3512 (GCFont
| GCForeground
| GCBackground
3513 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3517 f
->output_data
.x
->white_relief
.gc
= 0;
3518 f
->output_data
.x
->black_relief
.gc
= 0;
3520 /* Create the gray border tile used when the pointer is not in
3521 the frame. Since this depends on the frame's pixel values,
3522 this must be done on a per-frame basis. */
3523 f
->output_data
.x
->border_tile
3524 = (XCreatePixmapFromBitmapData
3525 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3526 gray_bits
, gray_width
, gray_height
,
3527 f
->output_data
.x
->foreground_pixel
,
3528 f
->output_data
.x
->background_pixel
,
3529 DefaultDepth (FRAME_X_DISPLAY (f
),
3530 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3535 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3537 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3538 Returns an Emacs frame object.\n\
3539 ALIST is an alist of frame parameters.\n\
3540 If the parameters specify that the frame should not have a minibuffer,\n\
3541 and do not specify a specific minibuffer window to use,\n\
3542 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3543 be shared by the new frame.\n\
3545 This function is an internal primitive--use `make-frame' instead.")
3550 Lisp_Object frame
, tem
;
3552 int minibuffer_only
= 0;
3553 long window_prompting
= 0;
3555 int count
= specpdl_ptr
- specpdl
;
3556 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3557 Lisp_Object display
;
3558 struct x_display_info
*dpyinfo
= NULL
;
3564 /* Use this general default value to start with
3565 until we know if this frame has a specified name. */
3566 Vx_resource_name
= Vinvocation_name
;
3568 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3569 if (EQ (display
, Qunbound
))
3571 dpyinfo
= check_x_display_info (display
);
3573 kb
= dpyinfo
->kboard
;
3575 kb
= &the_only_kboard
;
3578 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3580 && ! EQ (name
, Qunbound
)
3582 error ("Invalid frame name--not a string or nil");
3585 Vx_resource_name
= name
;
3587 /* See if parent window is specified. */
3588 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3589 if (EQ (parent
, Qunbound
))
3591 if (! NILP (parent
))
3592 CHECK_NUMBER (parent
, 0);
3594 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3595 /* No need to protect DISPLAY because that's not used after passing
3596 it to make_frame_without_minibuffer. */
3598 GCPRO4 (parms
, parent
, name
, frame
);
3599 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3601 if (EQ (tem
, Qnone
) || NILP (tem
))
3602 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3603 else if (EQ (tem
, Qonly
))
3605 f
= make_minibuffer_frame ();
3606 minibuffer_only
= 1;
3608 else if (WINDOWP (tem
))
3609 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3613 XSETFRAME (frame
, f
);
3615 /* Note that X Windows does support scroll bars. */
3616 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3618 f
->output_method
= output_x_window
;
3619 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3620 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3621 f
->output_data
.x
->icon_bitmap
= -1;
3622 f
->output_data
.x
->fontset
= -1;
3623 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3624 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3627 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3629 if (! STRINGP (f
->icon_name
))
3630 f
->icon_name
= Qnil
;
3632 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3634 FRAME_KBOARD (f
) = kb
;
3637 /* Specify the parent under which to make this X window. */
3641 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3642 f
->output_data
.x
->explicit_parent
= 1;
3646 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3647 f
->output_data
.x
->explicit_parent
= 0;
3650 /* Set the name; the functions to which we pass f expect the name to
3652 if (EQ (name
, Qunbound
) || NILP (name
))
3654 f
->name
= build_string (dpyinfo
->x_id_name
);
3655 f
->explicit_name
= 0;
3660 f
->explicit_name
= 1;
3661 /* use the frame's title when getting resources for this frame. */
3662 specbind (Qx_resource_name
, name
);
3665 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3666 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3667 fs_register_fontset (f
, XCAR (tem
));
3669 /* Extract the window parameters from the supplied values
3670 that are needed to determine window geometry. */
3674 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3677 /* First, try whatever font the caller has specified. */
3680 tem
= Fquery_fontset (font
, Qnil
);
3682 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3684 font
= x_new_font (f
, XSTRING (font
)->data
);
3687 /* Try out a font which we hope has bold and italic variations. */
3688 if (!STRINGP (font
))
3689 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3690 if (!STRINGP (font
))
3691 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3692 if (! STRINGP (font
))
3693 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3694 if (! STRINGP (font
))
3695 /* This was formerly the first thing tried, but it finds too many fonts
3696 and takes too long. */
3697 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3698 /* If those didn't work, look for something which will at least work. */
3699 if (! STRINGP (font
))
3700 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3702 if (! STRINGP (font
))
3703 font
= build_string ("fixed");
3705 x_default_parameter (f
, parms
, Qfont
, font
,
3706 "font", "Font", RES_TYPE_STRING
);
3710 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3711 whereby it fails to get any font. */
3712 xlwmenu_default_font
= f
->output_data
.x
->font
;
3715 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3716 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3718 /* This defaults to 2 in order to match xterm. We recognize either
3719 internalBorderWidth or internalBorder (which is what xterm calls
3721 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3725 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3726 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3727 if (! EQ (value
, Qunbound
))
3728 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3731 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3732 "internalBorderWidth", "internalBorderWidth",
3734 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3735 "verticalScrollBars", "ScrollBars",
3738 /* Also do the stuff which must be set before the window exists. */
3739 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3740 "foreground", "Foreground", RES_TYPE_STRING
);
3741 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3742 "background", "Background", RES_TYPE_STRING
);
3743 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3744 "pointerColor", "Foreground", RES_TYPE_STRING
);
3745 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3746 "cursorColor", "Foreground", RES_TYPE_STRING
);
3747 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3748 "borderColor", "BorderColor", RES_TYPE_STRING
);
3749 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3750 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3752 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3753 "scrollBarForeground",
3754 "ScrollBarForeground", 1);
3755 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3756 "scrollBarBackground",
3757 "ScrollBarBackground", 0);
3759 /* Init faces before x_default_parameter is called for scroll-bar
3760 parameters because that function calls x_set_scroll_bar_width,
3761 which calls change_frame_size, which calls Fset_window_buffer,
3762 which runs hooks, which call Fvertical_motion. At the end, we
3763 end up in init_iterator with a null face cache, which should not
3765 init_frame_faces (f
);
3767 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3768 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3769 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3770 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3771 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3772 "scrollBarWidth", "ScrollBarWidth",
3774 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3775 "bufferPredicate", "BufferPredicate",
3777 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3778 "title", "Title", RES_TYPE_STRING
);
3780 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3781 window_prompting
= x_figure_window_size (f
, parms
);
3783 if (window_prompting
& XNegative
)
3785 if (window_prompting
& YNegative
)
3786 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3788 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3792 if (window_prompting
& YNegative
)
3793 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3795 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3798 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3800 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3801 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3803 /* Create the X widget or window. Add the tool-bar height to the
3804 initial frame height so that the user gets a text display area of
3805 the size he specified with -g or via .Xdefaults. Later changes
3806 of the tool-bar height don't change the frame size. This is done
3807 so that users can create tall Emacs frames without having to
3808 guess how tall the tool-bar will get. */
3809 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3811 #ifdef USE_X_TOOLKIT
3812 x_window (f
, window_prompting
, minibuffer_only
);
3820 /* Now consider the frame official. */
3821 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3822 Vframe_list
= Fcons (frame
, Vframe_list
);
3824 /* We need to do this after creating the X window, so that the
3825 icon-creation functions can say whose icon they're describing. */
3826 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3827 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3829 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3830 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3831 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3832 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3833 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3834 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3836 /* Dimensions, especially f->height, must be done via change_frame_size.
3837 Change will not be effected unless different from the current
3842 SET_FRAME_WIDTH (f
, 0);
3843 change_frame_size (f
, height
, width
, 1, 0, 0);
3845 /* Set up faces after all frame parameters are known. */
3846 call1 (Qface_set_after_frame_default
, frame
);
3848 #ifdef USE_X_TOOLKIT
3849 /* Create the menu bar. */
3850 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3852 /* If this signals an error, we haven't set size hints for the
3853 frame and we didn't make it visible. */
3854 initialize_frame_menubar (f
);
3856 /* This is a no-op, except under Motif where it arranges the
3857 main window for the widgets on it. */
3858 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3859 f
->output_data
.x
->menubar_widget
,
3860 f
->output_data
.x
->edit_widget
);
3862 #endif /* USE_X_TOOLKIT */
3864 /* Tell the server what size and position, etc, we want, and how
3865 badly we want them. This should be done after we have the menu
3866 bar so that its size can be taken into account. */
3868 x_wm_set_size_hint (f
, window_prompting
, 0);
3871 /* Make the window appear on the frame and enable display, unless
3872 the caller says not to. However, with explicit parent, Emacs
3873 cannot control visibility, so don't try. */
3874 if (! f
->output_data
.x
->explicit_parent
)
3876 Lisp_Object visibility
;
3878 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3880 if (EQ (visibility
, Qunbound
))
3883 if (EQ (visibility
, Qicon
))
3884 x_iconify_frame (f
);
3885 else if (! NILP (visibility
))
3886 x_make_frame_visible (f
);
3888 /* Must have been Qnil. */
3893 return unbind_to (count
, frame
);
3896 /* FRAME is used only to get a handle on the X display. We don't pass the
3897 display info directly because we're called from frame.c, which doesn't
3898 know about that structure. */
3901 x_get_focus_frame (frame
)
3902 struct frame
*frame
;
3904 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3906 if (! dpyinfo
->x_focus_frame
)
3909 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3914 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
3915 "Return non-nil if color COLOR is supported on frame FRAME.\n\
3916 If FRAME is omitted or nil, use the selected frame.")
3918 Lisp_Object color
, frame
;
3921 FRAME_PTR f
= check_x_frame (frame
);
3923 CHECK_STRING (color
, 1);
3925 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3931 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
3932 "Return a description of the color named COLOR on frame FRAME.\n\
3933 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3934 These values appear to range from 0 to 65280 or 65535, depending\n\
3935 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3936 If FRAME is omitted or nil, use the selected frame.")
3938 Lisp_Object color
, frame
;
3941 FRAME_PTR f
= check_x_frame (frame
);
3943 CHECK_STRING (color
, 1);
3945 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3949 rgb
[0] = make_number (foo
.red
);
3950 rgb
[1] = make_number (foo
.green
);
3951 rgb
[2] = make_number (foo
.blue
);
3952 return Flist (3, rgb
);
3958 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
3959 "Return t if the X display supports color.\n\
3960 The optional argument DISPLAY specifies which display to ask about.\n\
3961 DISPLAY should be either a frame or a display name (a string).\n\
3962 If omitted or nil, that stands for the selected frame's display.")
3964 Lisp_Object display
;
3966 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3968 if (dpyinfo
->n_planes
<= 2)
3971 switch (dpyinfo
->visual
->class)
3984 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3986 "Return t if the X display supports shades of gray.\n\
3987 Note that color displays do support shades of gray.\n\
3988 The optional argument DISPLAY specifies which display to ask about.\n\
3989 DISPLAY should be either a frame or a display name (a string).\n\
3990 If omitted or nil, that stands for the selected frame's display.")
3992 Lisp_Object display
;
3994 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3996 if (dpyinfo
->n_planes
<= 1)
3999 switch (dpyinfo
->visual
->class)
4014 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4016 "Returns the width in pixels of the X display DISPLAY.\n\
4017 The optional argument DISPLAY specifies which display to ask about.\n\
4018 DISPLAY should be either a frame or a display name (a string).\n\
4019 If omitted or nil, that stands for the selected frame's display.")
4021 Lisp_Object display
;
4023 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4025 return make_number (dpyinfo
->width
);
4028 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4029 Sx_display_pixel_height
, 0, 1, 0,
4030 "Returns the height in pixels of the X display DISPLAY.\n\
4031 The optional argument DISPLAY specifies which display to ask about.\n\
4032 DISPLAY should be either a frame or a display name (a string).\n\
4033 If omitted or nil, that stands for the selected frame's display.")
4035 Lisp_Object display
;
4037 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4039 return make_number (dpyinfo
->height
);
4042 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4044 "Returns the number of bitplanes of the X display DISPLAY.\n\
4045 The optional argument DISPLAY specifies which display to ask about.\n\
4046 DISPLAY should be either a frame or a display name (a string).\n\
4047 If omitted or nil, that stands for the selected frame's display.")
4049 Lisp_Object display
;
4051 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4053 return make_number (dpyinfo
->n_planes
);
4056 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4058 "Returns the number of color cells of the X display DISPLAY.\n\
4059 The optional argument DISPLAY specifies which display to ask about.\n\
4060 DISPLAY should be either a frame or a display name (a string).\n\
4061 If omitted or nil, that stands for the selected frame's display.")
4063 Lisp_Object display
;
4065 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4067 return make_number (DisplayCells (dpyinfo
->display
,
4068 XScreenNumberOfScreen (dpyinfo
->screen
)));
4071 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4072 Sx_server_max_request_size
,
4074 "Returns the maximum request size of the X server of display DISPLAY.\n\
4075 The optional argument DISPLAY specifies which display to ask about.\n\
4076 DISPLAY should be either a frame or a display name (a string).\n\
4077 If omitted or nil, that stands for the selected frame's display.")
4079 Lisp_Object display
;
4081 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4083 return make_number (MAXREQUEST (dpyinfo
->display
));
4086 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4087 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4088 The optional argument DISPLAY specifies which display to ask about.\n\
4089 DISPLAY should be either a frame or a display name (a string).\n\
4090 If omitted or nil, that stands for the selected frame's display.")
4092 Lisp_Object display
;
4094 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4095 char *vendor
= ServerVendor (dpyinfo
->display
);
4097 if (! vendor
) vendor
= "";
4098 return build_string (vendor
);
4101 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4102 "Returns the version numbers of the X server of display DISPLAY.\n\
4103 The value is a list of three integers: the major and minor\n\
4104 version numbers of the X Protocol in use, and the vendor-specific release\n\
4105 number. See also the function `x-server-vendor'.\n\n\
4106 The optional argument DISPLAY specifies which display to ask about.\n\
4107 DISPLAY should be either a frame or a display name (a string).\n\
4108 If omitted or nil, that stands for the selected frame's display.")
4110 Lisp_Object display
;
4112 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4113 Display
*dpy
= dpyinfo
->display
;
4115 return Fcons (make_number (ProtocolVersion (dpy
)),
4116 Fcons (make_number (ProtocolRevision (dpy
)),
4117 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4120 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4121 "Returns the number of screens on the X server of display DISPLAY.\n\
4122 The optional argument DISPLAY specifies which display to ask about.\n\
4123 DISPLAY should be either a frame or a display name (a string).\n\
4124 If omitted or nil, that stands for the selected frame's display.")
4126 Lisp_Object display
;
4128 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4130 return make_number (ScreenCount (dpyinfo
->display
));
4133 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4134 "Returns the height in millimeters of the X display DISPLAY.\n\
4135 The optional argument DISPLAY specifies which display to ask about.\n\
4136 DISPLAY should be either a frame or a display name (a string).\n\
4137 If omitted or nil, that stands for the selected frame's display.")
4139 Lisp_Object display
;
4141 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4143 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4146 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4147 "Returns the width in millimeters of the X display DISPLAY.\n\
4148 The optional argument DISPLAY specifies which display to ask about.\n\
4149 DISPLAY should be either a frame or a display name (a string).\n\
4150 If omitted or nil, that stands for the selected frame's display.")
4152 Lisp_Object display
;
4154 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4156 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4159 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4160 Sx_display_backing_store
, 0, 1, 0,
4161 "Returns an indication of whether X display DISPLAY does backing store.\n\
4162 The value may be `always', `when-mapped', or `not-useful'.\n\
4163 The optional argument DISPLAY specifies which display to ask about.\n\
4164 DISPLAY should be either a frame or a display name (a string).\n\
4165 If omitted or nil, that stands for the selected frame's display.")
4167 Lisp_Object display
;
4169 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4171 switch (DoesBackingStore (dpyinfo
->screen
))
4174 return intern ("always");
4177 return intern ("when-mapped");
4180 return intern ("not-useful");
4183 error ("Strange value for BackingStore parameter of screen");
4187 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4188 Sx_display_visual_class
, 0, 1, 0,
4189 "Returns the visual class of the X display DISPLAY.\n\
4190 The value is one of the symbols `static-gray', `gray-scale',\n\
4191 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4192 The optional argument DISPLAY specifies which display to ask about.\n\
4193 DISPLAY should be either a frame or a display name (a string).\n\
4194 If omitted or nil, that stands for the selected frame's display.")
4196 Lisp_Object display
;
4198 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4200 switch (dpyinfo
->visual
->class)
4202 case StaticGray
: return (intern ("static-gray"));
4203 case GrayScale
: return (intern ("gray-scale"));
4204 case StaticColor
: return (intern ("static-color"));
4205 case PseudoColor
: return (intern ("pseudo-color"));
4206 case TrueColor
: return (intern ("true-color"));
4207 case DirectColor
: return (intern ("direct-color"));
4209 error ("Display has an unknown visual class");
4213 DEFUN ("x-display-save-under", Fx_display_save_under
,
4214 Sx_display_save_under
, 0, 1, 0,
4215 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4216 The optional argument DISPLAY specifies which display to ask about.\n\
4217 DISPLAY should be either a frame or a display name (a string).\n\
4218 If omitted or nil, that stands for the selected frame's display.")
4220 Lisp_Object display
;
4222 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4224 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4232 register struct frame
*f
;
4234 return PIXEL_WIDTH (f
);
4239 register struct frame
*f
;
4241 return PIXEL_HEIGHT (f
);
4246 register struct frame
*f
;
4248 return FONT_WIDTH (f
->output_data
.x
->font
);
4253 register struct frame
*f
;
4255 return f
->output_data
.x
->line_height
;
4260 register struct frame
*f
;
4262 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4265 #if 0 /* These no longer seem like the right way to do things. */
4267 /* Draw a rectangle on the frame with left top corner including
4268 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4269 CHARS by LINES wide and long and is the color of the cursor. */
4272 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4273 register struct frame
*f
;
4275 register int top_char
, left_char
, chars
, lines
;
4279 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4280 + f
->output_data
.x
->internal_border_width
);
4281 int top
= (top_char
* f
->output_data
.x
->line_height
4282 + f
->output_data
.x
->internal_border_width
);
4285 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4287 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4289 height
= f
->output_data
.x
->line_height
/ 2;
4291 height
= f
->output_data
.x
->line_height
* lines
;
4293 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4294 gc
, left
, top
, width
, height
);
4297 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4298 "Draw a rectangle on FRAME between coordinates specified by\n\
4299 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4300 (frame
, X0
, Y0
, X1
, Y1
)
4301 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4303 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4305 CHECK_LIVE_FRAME (frame
, 0);
4306 CHECK_NUMBER (X0
, 0);
4307 CHECK_NUMBER (Y0
, 1);
4308 CHECK_NUMBER (X1
, 2);
4309 CHECK_NUMBER (Y1
, 3);
4319 n_lines
= y1
- y0
+ 1;
4324 n_lines
= y0
- y1
+ 1;
4330 n_chars
= x1
- x0
+ 1;
4335 n_chars
= x0
- x1
+ 1;
4339 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4340 left
, top
, n_chars
, n_lines
);
4346 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4347 "Draw a rectangle drawn on FRAME between coordinates\n\
4348 X0, Y0, X1, Y1 in the regular background-pixel.")
4349 (frame
, X0
, Y0
, X1
, Y1
)
4350 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4352 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4354 CHECK_LIVE_FRAME (frame
, 0);
4355 CHECK_NUMBER (X0
, 0);
4356 CHECK_NUMBER (Y0
, 1);
4357 CHECK_NUMBER (X1
, 2);
4358 CHECK_NUMBER (Y1
, 3);
4368 n_lines
= y1
- y0
+ 1;
4373 n_lines
= y0
- y1
+ 1;
4379 n_chars
= x1
- x0
+ 1;
4384 n_chars
= x0
- x1
+ 1;
4388 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4389 left
, top
, n_chars
, n_lines
);
4395 /* Draw lines around the text region beginning at the character position
4396 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4397 pixel and line characteristics. */
4399 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4402 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4403 register struct frame
*f
;
4405 int top_x
, top_y
, bottom_x
, bottom_y
;
4407 register int ibw
= f
->output_data
.x
->internal_border_width
;
4408 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4409 register int font_h
= f
->output_data
.x
->line_height
;
4411 int x
= line_len (y
);
4412 XPoint
*pixel_points
4413 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4414 register XPoint
*this_point
= pixel_points
;
4416 /* Do the horizontal top line/lines */
4419 this_point
->x
= ibw
;
4420 this_point
->y
= ibw
+ (font_h
* top_y
);
4423 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4425 this_point
->x
= ibw
+ (font_w
* x
);
4426 this_point
->y
= (this_point
- 1)->y
;
4430 this_point
->x
= ibw
;
4431 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4433 this_point
->x
= ibw
+ (font_w
* top_x
);
4434 this_point
->y
= (this_point
- 1)->y
;
4436 this_point
->x
= (this_point
- 1)->x
;
4437 this_point
->y
= ibw
+ (font_h
* top_y
);
4439 this_point
->x
= ibw
+ (font_w
* x
);
4440 this_point
->y
= (this_point
- 1)->y
;
4443 /* Now do the right side. */
4444 while (y
< bottom_y
)
4445 { /* Right vertical edge */
4447 this_point
->x
= (this_point
- 1)->x
;
4448 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4451 y
++; /* Horizontal connection to next line */
4454 this_point
->x
= ibw
+ (font_w
/ 2);
4456 this_point
->x
= ibw
+ (font_w
* x
);
4458 this_point
->y
= (this_point
- 1)->y
;
4461 /* Now do the bottom and connect to the top left point. */
4462 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4465 this_point
->x
= (this_point
- 1)->x
;
4466 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4468 this_point
->x
= ibw
;
4469 this_point
->y
= (this_point
- 1)->y
;
4471 this_point
->x
= pixel_points
->x
;
4472 this_point
->y
= pixel_points
->y
;
4474 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4476 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4479 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4480 "Highlight the region between point and the character under the mouse\n\
4483 register Lisp_Object event
;
4485 register int x0
, y0
, x1
, y1
;
4486 register struct frame
*f
= selected_frame
;
4487 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4488 register int p1
, p2
;
4490 CHECK_CONS (event
, 0);
4493 x0
= XINT (Fcar (Fcar (event
)));
4494 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4496 /* If the mouse is past the end of the line, don't that area. */
4497 /* ReWrite this... */
4499 /* Where the cursor is. */
4500 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4501 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4503 if (y1
> y0
) /* point below mouse */
4504 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4506 else if (y1
< y0
) /* point above mouse */
4507 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4509 else /* same line: draw horizontal rectangle */
4512 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4513 x0
, y0
, (x1
- x0
+ 1), 1);
4515 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4516 x1
, y1
, (x0
- x1
+ 1), 1);
4519 XFlush (FRAME_X_DISPLAY (f
));
4525 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4526 "Erase any highlighting of the region between point and the character\n\
4527 at X, Y on the selected frame.")
4529 register Lisp_Object event
;
4531 register int x0
, y0
, x1
, y1
;
4532 register struct frame
*f
= selected_frame
;
4533 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4536 x0
= XINT (Fcar (Fcar (event
)));
4537 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4538 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4539 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4541 if (y1
> y0
) /* point below mouse */
4542 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4544 else if (y1
< y0
) /* point above mouse */
4545 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4547 else /* same line: draw horizontal rectangle */
4550 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4551 x0
, y0
, (x1
- x0
+ 1), 1);
4553 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4554 x1
, y1
, (x0
- x1
+ 1), 1);
4562 int contour_begin_x
, contour_begin_y
;
4563 int contour_end_x
, contour_end_y
;
4564 int contour_npoints
;
4566 /* Clip the top part of the contour lines down (and including) line Y_POS.
4567 If X_POS is in the middle (rather than at the end) of the line, drop
4568 down a line at that character. */
4571 clip_contour_top (y_pos
, x_pos
)
4573 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4574 register XPoint
*end
;
4575 register int npoints
;
4576 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4578 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4580 end
= contour_lines
[y_pos
].top_right
;
4581 npoints
= (end
- begin
+ 1);
4582 XDrawLines (x_current_display
, contour_window
,
4583 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4585 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4586 contour_last_point
-= (npoints
- 2);
4587 XDrawLines (x_current_display
, contour_window
,
4588 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4589 XFlush (x_current_display
);
4591 /* Now, update contour_lines structure. */
4596 register XPoint
*p
= begin
+ 1;
4597 end
= contour_lines
[y_pos
].bottom_right
;
4598 npoints
= (end
- begin
+ 1);
4599 XDrawLines (x_current_display
, contour_window
,
4600 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4603 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4605 p
->y
= begin
->y
+ font_h
;
4607 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4608 contour_last_point
-= (npoints
- 5);
4609 XDrawLines (x_current_display
, contour_window
,
4610 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4611 XFlush (x_current_display
);
4613 /* Now, update contour_lines structure. */
4617 /* Erase the top horizontal lines of the contour, and then extend
4618 the contour upwards. */
4621 extend_contour_top (line
)
4626 clip_contour_bottom (x_pos
, y_pos
)
4632 extend_contour_bottom (x_pos
, y_pos
)
4636 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4641 register struct frame
*f
= selected_frame
;
4642 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4643 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4644 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4645 register int mouse_below_point
;
4646 register Lisp_Object obj
;
4647 register int x_contour_x
, x_contour_y
;
4649 x_contour_x
= x_mouse_x
;
4650 x_contour_y
= x_mouse_y
;
4651 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4652 && x_contour_x
> point_x
))
4654 mouse_below_point
= 1;
4655 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4656 x_contour_x
, x_contour_y
);
4660 mouse_below_point
= 0;
4661 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4667 obj
= read_char (-1, 0, 0, Qnil
, 0);
4671 if (mouse_below_point
)
4673 if (x_mouse_y
<= point_y
) /* Flipped. */
4675 mouse_below_point
= 0;
4677 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4678 x_contour_x
, x_contour_y
);
4679 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4682 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4684 clip_contour_bottom (x_mouse_y
);
4686 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4688 extend_bottom_contour (x_mouse_y
);
4691 x_contour_x
= x_mouse_x
;
4692 x_contour_y
= x_mouse_y
;
4694 else /* mouse above or same line as point */
4696 if (x_mouse_y
>= point_y
) /* Flipped. */
4698 mouse_below_point
= 1;
4700 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4701 x_contour_x
, x_contour_y
, point_x
, point_y
);
4702 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4703 x_mouse_x
, x_mouse_y
);
4705 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4707 clip_contour_top (x_mouse_y
);
4709 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4711 extend_contour_top (x_mouse_y
);
4716 unread_command_event
= obj
;
4717 if (mouse_below_point
)
4719 contour_begin_x
= point_x
;
4720 contour_begin_y
= point_y
;
4721 contour_end_x
= x_contour_x
;
4722 contour_end_y
= x_contour_y
;
4726 contour_begin_x
= x_contour_x
;
4727 contour_begin_y
= x_contour_y
;
4728 contour_end_x
= point_x
;
4729 contour_end_y
= point_y
;
4734 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4739 register Lisp_Object obj
;
4740 struct frame
*f
= selected_frame
;
4741 register struct window
*w
= XWINDOW (selected_window
);
4742 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4743 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4745 char dash_list
[] = {6, 4, 6, 4};
4747 XGCValues gc_values
;
4749 register int previous_y
;
4750 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4751 + f
->output_data
.x
->internal_border_width
;
4752 register int left
= f
->output_data
.x
->internal_border_width
4753 + (WINDOW_LEFT_MARGIN (w
)
4754 * FONT_WIDTH (f
->output_data
.x
->font
));
4755 register int right
= left
+ (w
->width
4756 * FONT_WIDTH (f
->output_data
.x
->font
))
4757 - f
->output_data
.x
->internal_border_width
;
4761 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4762 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4763 gc_values
.line_width
= 1;
4764 gc_values
.line_style
= LineOnOffDash
;
4765 gc_values
.cap_style
= CapRound
;
4766 gc_values
.join_style
= JoinRound
;
4768 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4769 GCLineStyle
| GCJoinStyle
| GCCapStyle
4770 | GCLineWidth
| GCForeground
| GCBackground
,
4772 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4773 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4774 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4775 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4776 GCLineStyle
| GCJoinStyle
| GCCapStyle
4777 | GCLineWidth
| GCForeground
| GCBackground
,
4779 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4786 if (x_mouse_y
>= XINT (w
->top
)
4787 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4789 previous_y
= x_mouse_y
;
4790 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4791 + f
->output_data
.x
->internal_border_width
;
4792 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4793 line_gc
, left
, line
, right
, line
);
4795 XFlush (FRAME_X_DISPLAY (f
));
4800 obj
= read_char (-1, 0, 0, Qnil
, 0);
4802 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4803 Qvertical_scroll_bar
))
4807 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4808 erase_gc
, left
, line
, right
, line
);
4809 unread_command_event
= obj
;
4811 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4812 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4818 while (x_mouse_y
== previous_y
);
4821 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4822 erase_gc
, left
, line
, right
, line
);
4829 /* These keep track of the rectangle following the pointer. */
4830 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4832 /* Offset in buffer of character under the pointer, or 0. */
4833 int mouse_buffer_offset
;
4835 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4836 "Track the pointer.")
4839 static Cursor current_pointer_shape
;
4840 FRAME_PTR f
= x_mouse_frame
;
4843 if (EQ (Vmouse_frame_part
, Qtext_part
)
4844 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4849 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4850 XDefineCursor (FRAME_X_DISPLAY (f
),
4852 current_pointer_shape
);
4854 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4855 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4857 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4858 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4860 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4861 XDefineCursor (FRAME_X_DISPLAY (f
),
4863 current_pointer_shape
);
4866 XFlush (FRAME_X_DISPLAY (f
));
4872 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4873 "Draw rectangle around character under mouse pointer, if there is one.")
4877 struct window
*w
= XWINDOW (Vmouse_window
);
4878 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4879 struct buffer
*b
= XBUFFER (w
->buffer
);
4882 if (! EQ (Vmouse_window
, selected_window
))
4885 if (EQ (event
, Qnil
))
4889 x_read_mouse_position (selected_frame
, &x
, &y
);
4893 mouse_track_width
= 0;
4894 mouse_track_left
= mouse_track_top
= -1;
4898 if ((x_mouse_x
!= mouse_track_left
4899 && (x_mouse_x
< mouse_track_left
4900 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4901 || x_mouse_y
!= mouse_track_top
)
4903 int hp
= 0; /* Horizontal position */
4904 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4905 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4906 int tab_width
= XINT (b
->tab_width
);
4907 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4909 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4910 int in_mode_line
= 0;
4912 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4915 /* Erase previous rectangle. */
4916 if (mouse_track_width
)
4918 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4919 mouse_track_left
, mouse_track_top
,
4920 mouse_track_width
, 1);
4922 if ((mouse_track_left
== f
->phys_cursor_x
4923 || mouse_track_left
== f
->phys_cursor_x
- 1)
4924 && mouse_track_top
== f
->phys_cursor_y
)
4926 x_display_cursor (f
, 1);
4930 mouse_track_left
= x_mouse_x
;
4931 mouse_track_top
= x_mouse_y
;
4932 mouse_track_width
= 0;
4934 if (mouse_track_left
> len
) /* Past the end of line. */
4937 if (mouse_track_top
== mode_line_vpos
)
4943 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4947 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4953 mouse_track_width
= tab_width
- (hp
% tab_width
);
4955 hp
+= mouse_track_width
;
4958 mouse_track_left
= hp
- mouse_track_width
;
4964 mouse_track_width
= -1;
4968 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4973 mouse_track_width
= 2;
4978 mouse_track_left
= hp
- mouse_track_width
;
4984 mouse_track_width
= 1;
4991 while (hp
<= x_mouse_x
);
4994 if (mouse_track_width
) /* Over text; use text pointer shape. */
4996 XDefineCursor (FRAME_X_DISPLAY (f
),
4998 f
->output_data
.x
->text_cursor
);
4999 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
5000 mouse_track_left
, mouse_track_top
,
5001 mouse_track_width
, 1);
5003 else if (in_mode_line
)
5004 XDefineCursor (FRAME_X_DISPLAY (f
),
5006 f
->output_data
.x
->modeline_cursor
);
5008 XDefineCursor (FRAME_X_DISPLAY (f
),
5010 f
->output_data
.x
->nontext_cursor
);
5013 XFlush (FRAME_X_DISPLAY (f
));
5016 obj
= read_char (-1, 0, 0, Qnil
, 0);
5019 while (CONSP (obj
) /* Mouse event */
5020 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5021 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5022 && EQ (Vmouse_window
, selected_window
) /* In this window */
5025 unread_command_event
= obj
;
5027 if (mouse_track_width
)
5029 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5030 mouse_track_left
, mouse_track_top
,
5031 mouse_track_width
, 1);
5032 mouse_track_width
= 0;
5033 if ((mouse_track_left
== f
->phys_cursor_x
5034 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5035 && mouse_track_top
== f
->phys_cursor_y
)
5037 x_display_cursor (f
, 1);
5040 XDefineCursor (FRAME_X_DISPLAY (f
),
5042 f
->output_data
.x
->nontext_cursor
);
5043 XFlush (FRAME_X_DISPLAY (f
));
5053 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5054 on the frame F at position X, Y. */
5056 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5058 int x
, y
, width
, height
;
5063 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5064 FRAME_X_WINDOW (f
), image_data
,
5066 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5067 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5071 #if 0 /* I'm told these functions are superfluous
5072 given the ability to bind function keys. */
5075 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5076 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5077 KEYSYM is a string which conforms to the X keysym definitions found\n\
5078 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5079 list of strings specifying modifier keys such as Control_L, which must\n\
5080 also be depressed for NEWSTRING to appear.")
5081 (x_keysym
, modifiers
, newstring
)
5082 register Lisp_Object x_keysym
;
5083 register Lisp_Object modifiers
;
5084 register Lisp_Object newstring
;
5087 register KeySym keysym
;
5088 KeySym modifier_list
[16];
5091 CHECK_STRING (x_keysym
, 1);
5092 CHECK_STRING (newstring
, 3);
5094 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5095 if (keysym
== NoSymbol
)
5096 error ("Keysym does not exist");
5098 if (NILP (modifiers
))
5099 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5100 XSTRING (newstring
)->data
,
5101 STRING_BYTES (XSTRING (newstring
)));
5104 register Lisp_Object rest
, mod
;
5107 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5110 error ("Can't have more than 16 modifiers");
5113 CHECK_STRING (mod
, 3);
5114 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5116 if (modifier_list
[i
] == NoSymbol
5117 || !(IsModifierKey (modifier_list
[i
])
5118 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5119 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5121 if (modifier_list
[i
] == NoSymbol
5122 || !IsModifierKey (modifier_list
[i
]))
5124 error ("Element is not a modifier keysym");
5128 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5129 XSTRING (newstring
)->data
,
5130 STRING_BYTES (XSTRING (newstring
)));
5136 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5137 "Rebind KEYCODE to list of strings STRINGS.\n\
5138 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5139 nil as element means don't change.\n\
5140 See the documentation of `x-rebind-key' for more information.")
5142 register Lisp_Object keycode
;
5143 register Lisp_Object strings
;
5145 register Lisp_Object item
;
5146 register unsigned char *rawstring
;
5147 KeySym rawkey
, modifier
[1];
5149 register unsigned i
;
5152 CHECK_NUMBER (keycode
, 1);
5153 CHECK_CONS (strings
, 2);
5154 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5155 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5157 item
= Fcar (strings
);
5160 CHECK_STRING (item
, 2);
5161 strsize
= STRING_BYTES (XSTRING (item
));
5162 rawstring
= (unsigned char *) xmalloc (strsize
);
5163 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5164 modifier
[1] = 1 << i
;
5165 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5166 rawstring
, strsize
);
5171 #endif /* HAVE_X11 */
5174 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5176 XScreenNumberOfScreen (scr
)
5177 register Screen
*scr
;
5179 register Display
*dpy
;
5180 register Screen
*dpyscr
;
5184 dpyscr
= dpy
->screens
;
5186 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5192 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5195 select_visual (dpy
, screen
, depth
)
5198 unsigned int *depth
;
5201 XVisualInfo
*vinfo
, vinfo_template
;
5204 v
= DefaultVisualOfScreen (screen
);
5207 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5209 vinfo_template
.visualid
= v
->visualid
;
5212 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5214 vinfo
= XGetVisualInfo (dpy
,
5215 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5218 fatal ("Can't get proper X visual info");
5220 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5221 *depth
= vinfo
->depth
;
5225 int n
= vinfo
->colormap_size
- 1;
5234 XFree ((char *) vinfo
);
5238 /* Return the X display structure for the display named NAME.
5239 Open a new connection if necessary. */
5241 struct x_display_info
*
5242 x_display_info_for_name (name
)
5246 struct x_display_info
*dpyinfo
;
5248 CHECK_STRING (name
, 0);
5250 if (! EQ (Vwindow_system
, intern ("x")))
5251 error ("Not using X Windows");
5253 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5255 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5258 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5263 /* Use this general default value to start with. */
5264 Vx_resource_name
= Vinvocation_name
;
5266 validate_x_resource_name ();
5268 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5269 (char *) XSTRING (Vx_resource_name
)->data
);
5272 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5275 XSETFASTINT (Vwindow_system_version
, 11);
5280 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5281 1, 3, 0, "Open a connection to an X server.\n\
5282 DISPLAY is the name of the display to connect to.\n\
5283 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5284 If the optional third arg MUST-SUCCEED is non-nil,\n\
5285 terminate Emacs if we can't open the connection.")
5286 (display
, xrm_string
, must_succeed
)
5287 Lisp_Object display
, xrm_string
, must_succeed
;
5289 unsigned char *xrm_option
;
5290 struct x_display_info
*dpyinfo
;
5292 CHECK_STRING (display
, 0);
5293 if (! NILP (xrm_string
))
5294 CHECK_STRING (xrm_string
, 1);
5296 if (! EQ (Vwindow_system
, intern ("x")))
5297 error ("Not using X Windows");
5299 if (! NILP (xrm_string
))
5300 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5302 xrm_option
= (unsigned char *) 0;
5304 validate_x_resource_name ();
5306 /* This is what opens the connection and sets x_current_display.
5307 This also initializes many symbols, such as those used for input. */
5308 dpyinfo
= x_term_init (display
, xrm_option
,
5309 (char *) XSTRING (Vx_resource_name
)->data
);
5313 if (!NILP (must_succeed
))
5314 fatal ("Cannot connect to X server %s.\n\
5315 Check the DISPLAY environment variable or use `-d'.\n\
5316 Also use the `xhost' program to verify that it is set to permit\n\
5317 connections from your machine.\n",
5318 XSTRING (display
)->data
);
5320 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5325 XSETFASTINT (Vwindow_system_version
, 11);
5329 DEFUN ("x-close-connection", Fx_close_connection
,
5330 Sx_close_connection
, 1, 1, 0,
5331 "Close the connection to DISPLAY's X server.\n\
5332 For DISPLAY, specify either a frame or a display name (a string).\n\
5333 If DISPLAY is nil, that stands for the selected frame's display.")
5335 Lisp_Object display
;
5337 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5340 if (dpyinfo
->reference_count
> 0)
5341 error ("Display still has frames on it");
5344 /* Free the fonts in the font table. */
5345 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5346 if (dpyinfo
->font_table
[i
].name
)
5348 xfree (dpyinfo
->font_table
[i
].name
);
5349 /* Don't free the full_name string;
5350 it is always shared with something else. */
5351 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5354 x_destroy_all_bitmaps (dpyinfo
);
5355 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5357 #ifdef USE_X_TOOLKIT
5358 XtCloseDisplay (dpyinfo
->display
);
5360 XCloseDisplay (dpyinfo
->display
);
5363 x_delete_display (dpyinfo
);
5369 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5370 "Return the list of display names that Emacs has connections to.")
5373 Lisp_Object tail
, result
;
5376 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5377 result
= Fcons (XCAR (XCAR (tail
)), result
);
5382 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5383 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5384 If ON is nil, allow buffering of requests.\n\
5385 Turning on synchronization prohibits the Xlib routines from buffering\n\
5386 requests and seriously degrades performance, but makes debugging much\n\
5388 The optional second argument DISPLAY specifies which display to act on.\n\
5389 DISPLAY should be either a frame or a display name (a string).\n\
5390 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5392 Lisp_Object display
, on
;
5394 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5396 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5401 /* Wait for responses to all X commands issued so far for frame F. */
5408 XSync (FRAME_X_DISPLAY (f
), False
);
5413 /***********************************************************************
5415 ***********************************************************************/
5417 /* Value is the number of elements of vector VECTOR. */
5419 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5421 /* List of supported image types. Use define_image_type to add new
5422 types. Use lookup_image_type to find a type for a given symbol. */
5424 static struct image_type
*image_types
;
5426 /* A list of symbols, one for each supported image type. */
5428 Lisp_Object Vimage_types
;
5430 /* The symbol `image' which is the car of the lists used to represent
5433 extern Lisp_Object Qimage
;
5435 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5441 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5442 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5443 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5444 Lisp_Object QCindex
;
5446 /* Other symbols. */
5448 Lisp_Object Qlaplace
;
5450 /* Time in seconds after which images should be removed from the cache
5451 if not displayed. */
5453 Lisp_Object Vimage_cache_eviction_delay
;
5455 /* Function prototypes. */
5457 static void define_image_type
P_ ((struct image_type
*type
));
5458 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5459 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5460 static void x_laplace
P_ ((struct frame
*, struct image
*));
5461 static int x_build_heuristic_mask
P_ ((struct frame
*, Lisp_Object
,
5462 struct image
*, Lisp_Object
));
5465 /* Define a new image type from TYPE. This adds a copy of TYPE to
5466 image_types and adds the symbol *TYPE->type to Vimage_types. */
5469 define_image_type (type
)
5470 struct image_type
*type
;
5472 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5473 The initialized data segment is read-only. */
5474 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5475 bcopy (type
, p
, sizeof *p
);
5476 p
->next
= image_types
;
5478 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5482 /* Look up image type SYMBOL, and return a pointer to its image_type
5483 structure. Value is null if SYMBOL is not a known image type. */
5485 static INLINE
struct image_type
*
5486 lookup_image_type (symbol
)
5489 struct image_type
*type
;
5491 for (type
= image_types
; type
; type
= type
->next
)
5492 if (EQ (symbol
, *type
->type
))
5499 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5500 valid image specification is a list whose car is the symbol
5501 `image', and whose rest is a property list. The property list must
5502 contain a value for key `:type'. That value must be the name of a
5503 supported image type. The rest of the property list depends on the
5507 valid_image_p (object
)
5512 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5514 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5515 struct image_type
*type
= lookup_image_type (symbol
);
5518 valid_p
= type
->valid_p (object
);
5525 /* Log error message with format string FORMAT and argument ARG.
5526 Signaling an error, e.g. when an image cannot be loaded, is not a
5527 good idea because this would interrupt redisplay, and the error
5528 message display would lead to another redisplay. This function
5529 therefore simply displays a message. */
5532 image_error (format
, arg1
, arg2
)
5534 Lisp_Object arg1
, arg2
;
5536 add_to_log (format
, arg1
, arg2
);
5541 /***********************************************************************
5542 Image specifications
5543 ***********************************************************************/
5545 enum image_value_type
5547 IMAGE_DONT_CHECK_VALUE_TYPE
,
5550 IMAGE_POSITIVE_INTEGER_VALUE
,
5551 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5552 IMAGE_INTEGER_VALUE
,
5553 IMAGE_FUNCTION_VALUE
,
5558 /* Structure used when parsing image specifications. */
5560 struct image_keyword
5562 /* Name of keyword. */
5565 /* The type of value allowed. */
5566 enum image_value_type type
;
5568 /* Non-zero means key must be present. */
5571 /* Used to recognize duplicate keywords in a property list. */
5574 /* The value that was found. */
5579 static int parse_image_spec
P_ ((Lisp_Object spec
,
5580 struct image_keyword
*keywords
,
5581 int nkeywords
, Lisp_Object type
,
5582 int allow_other_keys_p
));
5583 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5586 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5587 has the format (image KEYWORD VALUE ...). One of the keyword/
5588 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5589 image_keywords structures of size NKEYWORDS describing other
5590 allowed keyword/value pairs. ALLOW_OTHER_KEYS_P non-zero means
5591 allow KEYWORD/VALUE pairs other than those described by KEYWORDS
5592 without checking them. Value is non-zero if SPEC is valid. */
5595 parse_image_spec (spec
, keywords
, nkeywords
, type
, allow_other_keys_p
)
5597 struct image_keyword
*keywords
;
5600 int allow_other_keys_p
;
5605 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5608 plist
= XCDR (spec
);
5609 while (CONSP (plist
))
5611 Lisp_Object key
, value
;
5613 /* First element of a pair must be a symbol. */
5615 plist
= XCDR (plist
);
5619 /* There must follow a value. */
5622 value
= XCAR (plist
);
5623 plist
= XCDR (plist
);
5625 /* Find key in KEYWORDS. Error if not found. */
5626 for (i
= 0; i
< nkeywords
; ++i
)
5627 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5632 if (!allow_other_keys_p
)
5637 /* Record that we recognized the keyword. If a keywords
5638 was found more than once, it's an error. */
5639 keywords
[i
].value
= value
;
5640 ++keywords
[i
].count
;
5642 if (keywords
[i
].count
> 1)
5645 /* Check type of value against allowed type. */
5646 switch (keywords
[i
].type
)
5648 case IMAGE_STRING_VALUE
:
5649 if (!STRINGP (value
))
5653 case IMAGE_SYMBOL_VALUE
:
5654 if (!SYMBOLP (value
))
5658 case IMAGE_POSITIVE_INTEGER_VALUE
:
5659 if (!INTEGERP (value
) || XINT (value
) <= 0)
5663 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5664 if (!INTEGERP (value
) || XINT (value
) < 0)
5668 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5671 case IMAGE_FUNCTION_VALUE
:
5672 value
= indirect_function (value
);
5674 || COMPILEDP (value
)
5675 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5679 case IMAGE_NUMBER_VALUE
:
5680 if (!INTEGERP (value
) && !FLOATP (value
))
5684 case IMAGE_INTEGER_VALUE
:
5685 if (!INTEGERP (value
))
5689 case IMAGE_BOOL_VALUE
:
5690 if (!NILP (value
) && !EQ (value
, Qt
))
5699 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5703 /* Check that all mandatory fields are present. */
5704 for (i
= 0; i
< nkeywords
; ++i
)
5705 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5708 return NILP (plist
);
5712 /* Return the value of KEY in image specification SPEC. Value is nil
5713 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5714 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5717 image_spec_value (spec
, key
, found
)
5718 Lisp_Object spec
, key
;
5723 xassert (valid_image_p (spec
));
5725 for (tail
= XCDR (spec
);
5726 CONSP (tail
) && CONSP (XCDR (tail
));
5727 tail
= XCDR (XCDR (tail
)))
5729 if (EQ (XCAR (tail
), key
))
5733 return XCAR (XCDR (tail
));
5745 /***********************************************************************
5746 Image type independent image structures
5747 ***********************************************************************/
5749 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5750 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5753 /* Allocate and return a new image structure for image specification
5754 SPEC. SPEC has a hash value of HASH. */
5756 static struct image
*
5757 make_image (spec
, hash
)
5761 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5763 xassert (valid_image_p (spec
));
5764 bzero (img
, sizeof *img
);
5765 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5766 xassert (img
->type
!= NULL
);
5768 img
->data
.lisp_val
= Qnil
;
5769 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5775 /* Free image IMG which was used on frame F, including its resources. */
5784 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5786 /* Remove IMG from the hash table of its cache. */
5788 img
->prev
->next
= img
->next
;
5790 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5793 img
->next
->prev
= img
->prev
;
5795 c
->images
[img
->id
] = NULL
;
5797 /* Free resources, then free IMG. */
5798 img
->type
->free (f
, img
);
5804 /* Prepare image IMG for display on frame F. Must be called before
5805 drawing an image. */
5808 prepare_image_for_display (f
, img
)
5814 /* We're about to display IMG, so set its timestamp to `now'. */
5816 img
->timestamp
= EMACS_SECS (t
);
5818 /* If IMG doesn't have a pixmap yet, load it now, using the image
5819 type dependent loader function. */
5820 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5821 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5826 /***********************************************************************
5827 Helper functions for X image types
5828 ***********************************************************************/
5830 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5831 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5833 Lisp_Object color_name
,
5834 unsigned long dflt
));
5836 /* Free X resources of image IMG which is used on frame F. */
5839 x_clear_image (f
, img
)
5846 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5853 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5855 /* If display has an immutable color map, freeing colors is not
5856 necessary and some servers don't allow it. So don't do it. */
5857 if (class != StaticColor
5858 && class != StaticGray
5859 && class != TrueColor
)
5863 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5864 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5869 xfree (img
->colors
);
5876 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5877 cannot be allocated, use DFLT. Add a newly allocated color to
5878 IMG->colors, so that it can be freed again. Value is the pixel
5881 static unsigned long
5882 x_alloc_image_color (f
, img
, color_name
, dflt
)
5885 Lisp_Object color_name
;
5889 unsigned long result
;
5891 xassert (STRINGP (color_name
));
5893 if (defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5895 /* This isn't called frequently so we get away with simply
5896 reallocating the color vector to the needed size, here. */
5899 (unsigned long *) xrealloc (img
->colors
,
5900 img
->ncolors
* sizeof *img
->colors
);
5901 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5902 result
= color
.pixel
;
5912 /***********************************************************************
5914 ***********************************************************************/
5916 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5919 /* Return a new, initialized image cache that is allocated from the
5920 heap. Call free_image_cache to free an image cache. */
5922 struct image_cache
*
5925 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5928 bzero (c
, sizeof *c
);
5930 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5931 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5932 c
->buckets
= (struct image
**) xmalloc (size
);
5933 bzero (c
->buckets
, size
);
5938 /* Free image cache of frame F. Be aware that X frames share images
5942 free_image_cache (f
)
5945 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5950 /* Cache should not be referenced by any frame when freed. */
5951 xassert (c
->refcount
== 0);
5953 for (i
= 0; i
< c
->used
; ++i
)
5954 free_image (f
, c
->images
[i
]);
5958 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5963 /* Clear image cache of frame F. FORCE_P non-zero means free all
5964 images. FORCE_P zero means clear only images that haven't been
5965 displayed for some time. Should be called from time to time to
5966 reduce the number of loaded images. If image-eviction-seconds is
5967 non-nil, this frees images in the cache which weren't displayed for
5968 at least that many seconds. */
5971 clear_image_cache (f
, force_p
)
5975 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5977 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5981 int i
, any_freed_p
= 0;
5984 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5986 for (i
= 0; i
< c
->used
; ++i
)
5988 struct image
*img
= c
->images
[i
];
5991 || (img
->timestamp
> old
)))
5993 free_image (f
, img
);
5998 /* We may be clearing the image cache because, for example,
5999 Emacs was iconified for a longer period of time. In that
6000 case, current matrices may still contain references to
6001 images freed above. So, clear these matrices. */
6004 clear_current_matrices (f
);
6005 ++windows_or_buffers_changed
;
6011 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
6013 "Clear the image cache of FRAME.\n\
6014 FRAME nil or omitted means use the selected frame.\n\
6015 FRAME t means clear the image caches of all frames.")
6023 FOR_EACH_FRAME (tail
, frame
)
6024 if (FRAME_X_P (XFRAME (frame
)))
6025 clear_image_cache (XFRAME (frame
), 1);
6028 clear_image_cache (check_x_frame (frame
), 1);
6034 /* Return the id of image with Lisp specification SPEC on frame F.
6035 SPEC must be a valid Lisp image specification (see valid_image_p). */
6038 lookup_image (f
, spec
)
6042 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6046 struct gcpro gcpro1
;
6049 /* F must be a window-system frame, and SPEC must be a valid image
6051 xassert (FRAME_WINDOW_P (f
));
6052 xassert (valid_image_p (spec
));
6056 /* Look up SPEC in the hash table of the image cache. */
6057 hash
= sxhash (spec
, 0);
6058 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6060 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6061 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6064 /* If not found, create a new image and cache it. */
6067 img
= make_image (spec
, hash
);
6068 cache_image (f
, img
);
6069 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6070 xassert (!interrupt_input_blocked
);
6072 /* If we can't load the image, and we don't have a width and
6073 height, use some arbitrary width and height so that we can
6074 draw a rectangle for it. */
6075 if (img
->load_failed_p
)
6079 value
= image_spec_value (spec
, QCwidth
, NULL
);
6080 img
->width
= (INTEGERP (value
)
6081 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6082 value
= image_spec_value (spec
, QCheight
, NULL
);
6083 img
->height
= (INTEGERP (value
)
6084 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6088 /* Handle image type independent image attributes
6089 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6090 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6093 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6094 if (INTEGERP (ascent
))
6095 img
->ascent
= XFASTINT (ascent
);
6097 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6098 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6099 img
->margin
= XFASTINT (margin
);
6101 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6102 if (INTEGERP (relief
))
6104 img
->relief
= XINT (relief
);
6105 img
->margin
+= abs (img
->relief
);
6108 /* Should we apply a Laplace edge-detection algorithm? */
6109 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6110 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6113 /* Should we built a mask heuristically? */
6114 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6115 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6117 file
= image_spec_value (spec
, QCfile
, NULL
);
6118 x_build_heuristic_mask (f
, file
, img
, heuristic_mask
);
6123 /* We're using IMG, so set its timestamp to `now'. */
6124 EMACS_GET_TIME (now
);
6125 img
->timestamp
= EMACS_SECS (now
);
6129 /* Value is the image id. */
6134 /* Cache image IMG in the image cache of frame F. */
6137 cache_image (f
, img
)
6141 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6144 /* Find a free slot in c->images. */
6145 for (i
= 0; i
< c
->used
; ++i
)
6146 if (c
->images
[i
] == NULL
)
6149 /* If no free slot found, maybe enlarge c->images. */
6150 if (i
== c
->used
&& c
->used
== c
->size
)
6153 c
->images
= (struct image
**) xrealloc (c
->images
,
6154 c
->size
* sizeof *c
->images
);
6157 /* Add IMG to c->images, and assign IMG an id. */
6163 /* Add IMG to the cache's hash table. */
6164 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6165 img
->next
= c
->buckets
[i
];
6167 img
->next
->prev
= img
;
6169 c
->buckets
[i
] = img
;
6173 /* Call FN on every image in the image cache of frame F. Used to mark
6174 Lisp Objects in the image cache. */
6177 forall_images_in_image_cache (f
, fn
)
6179 void (*fn
) P_ ((struct image
*img
));
6181 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6183 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6187 for (i
= 0; i
< c
->used
; ++i
)
6196 /***********************************************************************
6198 ***********************************************************************/
6200 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, Lisp_Object
,
6201 int, int, int, XImage
**,
6203 static void x_destroy_x_image
P_ ((XImage
*));
6204 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6207 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6208 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6209 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6210 via xmalloc. Print error messages via image_error if an error
6211 occurs. FILE is the name of an image file being processed, for
6212 error messages. Value is non-zero if successful. */
6215 x_create_x_image_and_pixmap (f
, file
, width
, height
, depth
, ximg
, pixmap
)
6218 int width
, height
, depth
;
6222 Display
*display
= FRAME_X_DISPLAY (f
);
6223 Screen
*screen
= FRAME_X_SCREEN (f
);
6224 Window window
= FRAME_X_WINDOW (f
);
6226 xassert (interrupt_input_blocked
);
6229 depth
= DefaultDepthOfScreen (screen
);
6230 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6231 depth
, ZPixmap
, 0, NULL
, width
, height
,
6232 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6235 image_error ("Unable to allocate X image for %s", file
, Qnil
);
6239 /* Allocate image raster. */
6240 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6242 /* Allocate a pixmap of the same size. */
6243 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6246 x_destroy_x_image (*ximg
);
6248 image_error ("Unable to create pixmap for `%s'", file
, Qnil
);
6256 /* Destroy XImage XIMG. Free XIMG->data. */
6259 x_destroy_x_image (ximg
)
6262 xassert (interrupt_input_blocked
);
6267 XDestroyImage (ximg
);
6272 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6273 are width and height of both the image and pixmap. */
6276 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6283 xassert (interrupt_input_blocked
);
6284 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6285 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6286 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6291 /***********************************************************************
6293 ***********************************************************************/
6295 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6297 /* Find image file FILE. Look in data-directory, then
6298 x-bitmap-file-path. Value is the full name of the file found, or
6299 nil if not found. */
6302 x_find_image_file (file
)
6305 Lisp_Object file_found
, search_path
;
6306 struct gcpro gcpro1
, gcpro2
;
6310 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6311 GCPRO2 (file_found
, search_path
);
6313 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6314 fd
= openp (search_path
, file
, "", &file_found
, 0);
6327 /***********************************************************************
6329 ***********************************************************************/
6331 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6332 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6334 static int xbm_image_p
P_ ((Lisp_Object object
));
6335 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6339 /* Indices of image specification fields in xbm_format, below. */
6341 enum xbm_keyword_index
6358 /* Vector of image_keyword structures describing the format
6359 of valid XBM image specifications. */
6361 static struct image_keyword xbm_format
[XBM_LAST
] =
6363 {":type", IMAGE_SYMBOL_VALUE
, 1},
6364 {":file", IMAGE_STRING_VALUE
, 0},
6365 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6366 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6367 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6368 {":foreground", IMAGE_STRING_VALUE
, 0},
6369 {":background", IMAGE_STRING_VALUE
, 0},
6370 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6371 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6372 {":relief", IMAGE_INTEGER_VALUE
, 0},
6373 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6374 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6377 /* Structure describing the image type XBM. */
6379 static struct image_type xbm_type
=
6388 /* Tokens returned from xbm_scan. */
6397 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6398 A valid specification is a list starting with the symbol `image'
6399 The rest of the list is a property list which must contain an
6402 If the specification specifies a file to load, it must contain
6403 an entry `:file FILENAME' where FILENAME is a string.
6405 If the specification is for a bitmap loaded from memory it must
6406 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6407 WIDTH and HEIGHT are integers > 0. DATA may be:
6409 1. a string large enough to hold the bitmap data, i.e. it must
6410 have a size >= (WIDTH + 7) / 8 * HEIGHT
6412 2. a bool-vector of size >= WIDTH * HEIGHT
6414 3. a vector of strings or bool-vectors, one for each line of the
6417 Both the file and data forms may contain the additional entries
6418 `:background COLOR' and `:foreground COLOR'. If not present,
6419 foreground and background of the frame on which the image is
6420 displayed, is used. */
6423 xbm_image_p (object
)
6426 struct image_keyword kw
[XBM_LAST
];
6428 bcopy (xbm_format
, kw
, sizeof kw
);
6429 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
, 0))
6432 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6434 if (kw
[XBM_FILE
].count
)
6436 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6444 /* Entries for `:width', `:height' and `:data' must be present. */
6445 if (!kw
[XBM_WIDTH
].count
6446 || !kw
[XBM_HEIGHT
].count
6447 || !kw
[XBM_DATA
].count
)
6450 data
= kw
[XBM_DATA
].value
;
6451 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6452 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6454 /* Check type of data, and width and height against contents of
6460 /* Number of elements of the vector must be >= height. */
6461 if (XVECTOR (data
)->size
< height
)
6464 /* Each string or bool-vector in data must be large enough
6465 for one line of the image. */
6466 for (i
= 0; i
< height
; ++i
)
6468 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6472 if (XSTRING (elt
)->size
6473 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6476 else if (BOOL_VECTOR_P (elt
))
6478 if (XBOOL_VECTOR (elt
)->size
< width
)
6485 else if (STRINGP (data
))
6487 if (XSTRING (data
)->size
6488 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6491 else if (BOOL_VECTOR_P (data
))
6493 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6500 /* Baseline must be a value between 0 and 100 (a percentage). */
6501 if (kw
[XBM_ASCENT
].count
6502 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6509 /* Scan a bitmap file. FP is the stream to read from. Value is
6510 either an enumerator from enum xbm_token, or a character for a
6511 single-character token, or 0 at end of file. If scanning an
6512 identifier, store the lexeme of the identifier in SVAL. If
6513 scanning a number, store its value in *IVAL. */
6516 xbm_scan (fp
, sval
, ival
)
6523 /* Skip white space. */
6524 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6529 else if (isdigit (c
))
6531 int value
= 0, digit
;
6536 if (c
== 'x' || c
== 'X')
6538 while ((c
= fgetc (fp
)) != EOF
)
6542 else if (c
>= 'a' && c
<= 'f')
6543 digit
= c
- 'a' + 10;
6544 else if (c
>= 'A' && c
<= 'F')
6545 digit
= c
- 'A' + 10;
6548 value
= 16 * value
+ digit
;
6551 else if (isdigit (c
))
6554 while ((c
= fgetc (fp
)) != EOF
6556 value
= 8 * value
+ c
- '0';
6562 while ((c
= fgetc (fp
)) != EOF
6564 value
= 10 * value
+ c
- '0';
6572 else if (isalpha (c
) || c
== '_')
6575 while ((c
= fgetc (fp
)) != EOF
6576 && (isalnum (c
) || c
== '_'))
6588 /* Replacement for XReadBitmapFileData which isn't available under old
6589 X versions. FILE is the name of the bitmap file to read. Set
6590 *WIDTH and *HEIGHT to the width and height of the image. Return in
6591 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6595 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6597 int *width
, *height
;
6598 unsigned char **data
;
6601 char buffer
[BUFSIZ
];
6604 int bytes_per_line
, i
, nbytes
;
6610 LA1 = xbm_scan (fp, buffer, &value)
6612 #define expect(TOKEN) \
6613 if (LA1 != (TOKEN)) \
6618 #define expect_ident(IDENT) \
6619 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6624 fp
= fopen (file
, "r");
6628 *width
= *height
= -1;
6630 LA1
= xbm_scan (fp
, buffer
, &value
);
6632 /* Parse defines for width, height and hot-spots. */
6636 expect_ident ("define");
6637 expect (XBM_TK_IDENT
);
6639 if (LA1
== XBM_TK_NUMBER
);
6641 char *p
= strrchr (buffer
, '_');
6642 p
= p
? p
+ 1 : buffer
;
6643 if (strcmp (p
, "width") == 0)
6645 else if (strcmp (p
, "height") == 0)
6648 expect (XBM_TK_NUMBER
);
6651 if (*width
< 0 || *height
< 0)
6654 /* Parse bits. Must start with `static'. */
6655 expect_ident ("static");
6656 if (LA1
== XBM_TK_IDENT
)
6658 if (strcmp (buffer
, "unsigned") == 0)
6661 expect_ident ("char");
6663 else if (strcmp (buffer
, "short") == 0)
6667 if (*width
% 16 && *width
% 16 < 9)
6670 else if (strcmp (buffer
, "char") == 0)
6678 expect (XBM_TK_IDENT
);
6684 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6685 nbytes
= bytes_per_line
* *height
;
6686 p
= *data
= (char *) xmalloc (nbytes
);
6691 for (i
= 0; i
< nbytes
; i
+= 2)
6694 expect (XBM_TK_NUMBER
);
6697 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6700 if (LA1
== ',' || LA1
== '}')
6708 for (i
= 0; i
< nbytes
; ++i
)
6711 expect (XBM_TK_NUMBER
);
6715 if (LA1
== ',' || LA1
== '}')
6741 /* Load XBM image IMG which will be displayed on frame F from file
6742 SPECIFIED_FILE. Value is non-zero if successful. */
6745 xbm_load_image_from_file (f
, img
, specified_file
)
6748 Lisp_Object specified_file
;
6751 unsigned char *data
;
6754 struct gcpro gcpro1
;
6756 xassert (STRINGP (specified_file
));
6760 file
= x_find_image_file (specified_file
);
6761 if (!STRINGP (file
))
6763 image_error ("Cannot find image file %s", specified_file
, Qnil
);
6768 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6769 &img
->height
, &data
);
6772 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6773 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6774 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6777 xassert (img
->width
> 0 && img
->height
> 0);
6779 /* Get foreground and background colors, maybe allocate colors. */
6780 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6782 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6784 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6786 background
= x_alloc_image_color (f
, img
, value
, background
);
6790 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6793 img
->width
, img
->height
,
6794 foreground
, background
,
6798 if (img
->pixmap
== 0)
6800 x_clear_image (f
, img
);
6801 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6809 image_error ("Error loading XBM image %s", img
->spec
, Qnil
);
6816 /* Fill image IMG which is used on frame F with pixmap data. Value is
6817 non-zero if successful. */
6825 Lisp_Object file_name
;
6827 xassert (xbm_image_p (img
->spec
));
6829 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6830 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6831 if (STRINGP (file_name
))
6832 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6835 struct image_keyword fmt
[XBM_LAST
];
6838 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6839 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6843 /* Parse the list specification. */
6844 bcopy (xbm_format
, fmt
, sizeof fmt
);
6845 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
, 0);
6848 /* Get specified width, and height. */
6849 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6850 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6851 xassert (img
->width
> 0 && img
->height
> 0);
6855 if (fmt
[XBM_ASCENT
].count
)
6856 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6858 /* Get foreground and background colors, maybe allocate colors. */
6859 if (fmt
[XBM_FOREGROUND
].count
)
6860 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6862 if (fmt
[XBM_BACKGROUND
].count
)
6863 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6866 /* Set bits to the bitmap image data. */
6867 data
= fmt
[XBM_DATA
].value
;
6872 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6874 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6875 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6877 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6879 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6881 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6884 else if (STRINGP (data
))
6885 bits
= XSTRING (data
)->data
;
6887 bits
= XBOOL_VECTOR (data
)->data
;
6889 /* Create the pixmap. */
6890 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6892 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6895 img
->width
, img
->height
,
6896 foreground
, background
,
6902 image_error ("Unable to create pixmap for XBM image", Qnil
, Qnil
);
6903 x_clear_image (f
, img
);
6914 /***********************************************************************
6916 ***********************************************************************/
6920 static int xpm_image_p
P_ ((Lisp_Object object
));
6921 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6922 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6924 #include "X11/xpm.h"
6926 /* The symbol `xpm' identifying XPM-format images. */
6930 /* Indices of image specification fields in xpm_format, below. */
6932 enum xpm_keyword_index
6946 /* Vector of image_keyword structures describing the format
6947 of valid XPM image specifications. */
6949 static struct image_keyword xpm_format
[XPM_LAST
] =
6951 {":type", IMAGE_SYMBOL_VALUE
, 1},
6952 {":file", IMAGE_STRING_VALUE
, 0},
6953 {":data", IMAGE_STRING_VALUE
, 0},
6954 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6955 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6956 {":relief", IMAGE_INTEGER_VALUE
, 0},
6957 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6958 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6959 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6962 /* Structure describing the image type XBM. */
6964 static struct image_type xpm_type
=
6974 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6975 for XPM images. Such a list must consist of conses whose car and
6979 xpm_valid_color_symbols_p (color_symbols
)
6980 Lisp_Object color_symbols
;
6982 while (CONSP (color_symbols
))
6984 Lisp_Object sym
= XCAR (color_symbols
);
6986 || !STRINGP (XCAR (sym
))
6987 || !STRINGP (XCDR (sym
)))
6989 color_symbols
= XCDR (color_symbols
);
6992 return NILP (color_symbols
);
6996 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6999 xpm_image_p (object
)
7002 struct image_keyword fmt
[XPM_LAST
];
7003 bcopy (xpm_format
, fmt
, sizeof fmt
);
7004 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
, 0)
7005 /* Either `:file' or `:data' must be present. */
7006 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
7007 /* Either no `:color-symbols' or it's a list of conses
7008 whose car and cdr are strings. */
7009 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
7010 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
7011 && (fmt
[XPM_ASCENT
].count
== 0
7012 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
7016 /* Load image IMG which will be displayed on frame F. Value is
7017 non-zero if successful. */
7025 XpmAttributes attrs
;
7026 Lisp_Object specified_file
, color_symbols
;
7028 /* Configure the XPM lib. Use the visual of frame F. Allocate
7029 close colors. Return colors allocated. */
7030 bzero (&attrs
, sizeof attrs
);
7031 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7032 attrs
.valuemask
|= XpmVisual
;
7033 attrs
.valuemask
|= XpmReturnAllocPixels
;
7034 #ifdef XpmAllocCloseColors
7035 attrs
.alloc_close_colors
= 1;
7036 attrs
.valuemask
|= XpmAllocCloseColors
;
7038 attrs
.closeness
= 600;
7039 attrs
.valuemask
|= XpmCloseness
;
7042 /* If image specification contains symbolic color definitions, add
7043 these to `attrs'. */
7044 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7045 if (CONSP (color_symbols
))
7048 XpmColorSymbol
*xpm_syms
;
7051 attrs
.valuemask
|= XpmColorSymbols
;
7053 /* Count number of symbols. */
7054 attrs
.numsymbols
= 0;
7055 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7058 /* Allocate an XpmColorSymbol array. */
7059 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7060 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7061 bzero (xpm_syms
, size
);
7062 attrs
.colorsymbols
= xpm_syms
;
7064 /* Fill the color symbol array. */
7065 for (tail
= color_symbols
, i
= 0;
7067 ++i
, tail
= XCDR (tail
))
7069 Lisp_Object name
= XCAR (XCAR (tail
));
7070 Lisp_Object color
= XCDR (XCAR (tail
));
7071 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7072 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7073 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7074 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7078 /* Create a pixmap for the image, either from a file, or from a
7079 string buffer containing data in the same format as an XPM file. */
7081 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7082 if (STRINGP (specified_file
))
7084 Lisp_Object file
= x_find_image_file (specified_file
);
7085 if (!STRINGP (file
))
7087 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7092 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7093 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7098 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7099 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7100 XSTRING (buffer
)->data
,
7101 &img
->pixmap
, &img
->mask
,
7106 if (rc
== XpmSuccess
)
7108 /* Remember allocated colors. */
7109 img
->ncolors
= attrs
.nalloc_pixels
;
7110 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7111 * sizeof *img
->colors
);
7112 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7113 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7115 img
->width
= attrs
.width
;
7116 img
->height
= attrs
.height
;
7117 xassert (img
->width
> 0 && img
->height
> 0);
7119 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7121 XpmFreeAttributes (&attrs
);
7129 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7132 case XpmFileInvalid
:
7133 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7137 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7140 case XpmColorFailed
:
7141 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7145 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7150 return rc
== XpmSuccess
;
7153 #endif /* HAVE_XPM != 0 */
7156 /***********************************************************************
7158 ***********************************************************************/
7160 /* An entry in the color table mapping an RGB color to a pixel color. */
7165 unsigned long pixel
;
7167 /* Next in color table collision list. */
7168 struct ct_color
*next
;
7171 /* The bucket vector size to use. Must be prime. */
7175 /* Value is a hash of the RGB color given by R, G, and B. */
7177 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7179 /* The color hash table. */
7181 struct ct_color
**ct_table
;
7183 /* Number of entries in the color table. */
7185 int ct_colors_allocated
;
7187 /* Function prototypes. */
7189 static void init_color_table
P_ ((void));
7190 static void free_color_table
P_ ((void));
7191 static unsigned long *colors_in_color_table
P_ ((int *n
));
7192 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7193 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7196 /* Initialize the color table. */
7201 int size
= CT_SIZE
* sizeof (*ct_table
);
7202 ct_table
= (struct ct_color
**) xmalloc (size
);
7203 bzero (ct_table
, size
);
7204 ct_colors_allocated
= 0;
7208 /* Free memory associated with the color table. */
7214 struct ct_color
*p
, *next
;
7216 for (i
= 0; i
< CT_SIZE
; ++i
)
7217 for (p
= ct_table
[i
]; p
; p
= next
)
7228 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7229 entry for that color already is in the color table, return the
7230 pixel color of that entry. Otherwise, allocate a new color for R,
7231 G, B, and make an entry in the color table. */
7233 static unsigned long
7234 lookup_rgb_color (f
, r
, g
, b
)
7238 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7239 int i
= hash
% CT_SIZE
;
7242 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7243 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7257 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7258 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7263 ++ct_colors_allocated
;
7265 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7269 p
->pixel
= color
.pixel
;
7270 p
->next
= ct_table
[i
];
7274 return FRAME_FOREGROUND_PIXEL (f
);
7281 /* Look up pixel color PIXEL which is used on frame F in the color
7282 table. If not already present, allocate it. Value is PIXEL. */
7284 static unsigned long
7285 lookup_pixel_color (f
, pixel
)
7287 unsigned long pixel
;
7289 int i
= pixel
% CT_SIZE
;
7292 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7293 if (p
->pixel
== pixel
)
7304 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7305 color
.pixel
= pixel
;
7306 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7307 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7312 ++ct_colors_allocated
;
7314 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7319 p
->next
= ct_table
[i
];
7323 return FRAME_FOREGROUND_PIXEL (f
);
7330 /* Value is a vector of all pixel colors contained in the color table,
7331 allocated via xmalloc. Set *N to the number of colors. */
7333 static unsigned long *
7334 colors_in_color_table (n
)
7339 unsigned long *colors
;
7341 if (ct_colors_allocated
== 0)
7348 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7350 *n
= ct_colors_allocated
;
7352 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7353 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7354 colors
[j
++] = p
->pixel
;
7362 /***********************************************************************
7364 ***********************************************************************/
7366 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7367 int, XImage
*, int));
7368 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7369 XColor
*, int, XImage
*, int));
7372 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7373 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7374 the width of one row in the image. */
7377 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7387 for (x
= 0; x
< width
; ++x
)
7388 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7390 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7394 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7395 containing the pixel colors to write. F is the frame we are
7399 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7408 for (x
= 0; x
< width
; ++x
)
7409 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7413 /* Transform image IMG which is used on frame F with a Laplace
7414 edge-detection algorithm. The result is an image that can be used
7415 to draw disabled buttons, for example. */
7422 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7423 XImage
*ximg
, *oimg
;
7429 int in_y
, out_y
, rc
;
7434 /* Get the X image IMG->pixmap. */
7435 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7436 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7438 /* Allocate 3 input rows, and one output row of colors. */
7439 for (i
= 0; i
< 3; ++i
)
7440 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7441 out
= (long *) alloca (img
->width
* sizeof (long));
7443 /* Create an X image for output. */
7444 rc
= x_create_x_image_and_pixmap (f
, Qnil
, img
->width
, img
->height
, 0,
7447 /* Fill first two rows. */
7448 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7449 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7452 /* Write first row, all zeros. */
7453 init_color_table ();
7454 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7455 for (x
= 0; x
< img
->width
; ++x
)
7457 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7460 for (y
= 2; y
< img
->height
; ++y
)
7463 int rowb
= (y
+ 2) % 3;
7465 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7467 for (x
= 0; x
< img
->width
- 2; ++x
)
7469 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7470 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7471 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7473 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7477 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7480 /* Write last line, all zeros. */
7481 for (x
= 0; x
< img
->width
; ++x
)
7483 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7485 /* Free the input image, and free resources of IMG. */
7486 XDestroyImage (ximg
);
7487 x_clear_image (f
, img
);
7489 /* Put the output image into pixmap, and destroy it. */
7490 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7491 x_destroy_x_image (oimg
);
7493 /* Remember new pixmap and colors in IMG. */
7494 img
->pixmap
= pixmap
;
7495 img
->colors
= colors_in_color_table (&img
->ncolors
);
7496 free_color_table ();
7502 /* Build a mask for image IMG which is used on frame F. FILE is the
7503 name of an image file, for error messages. HOW determines how to
7504 determine the background color of IMG. If it is a list '(R G B)',
7505 with R, G, and B being integers >= 0, take that as the color of the
7506 background. Otherwise, determine the background color of IMG
7507 heuristically. Value is non-zero if successful. */
7510 x_build_heuristic_mask (f
, file
, img
, how
)
7516 Display
*dpy
= FRAME_X_DISPLAY (f
);
7517 XImage
*ximg
, *mask_img
;
7518 int x
, y
, rc
, look_at_corners_p
;
7523 /* Create an image and pixmap serving as mask. */
7524 rc
= x_create_x_image_and_pixmap (f
, file
, img
->width
, img
->height
, 1,
7525 &mask_img
, &img
->mask
);
7532 /* Get the X image of IMG->pixmap. */
7533 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7536 /* Determine the background color of ximg. If HOW is `(R G B)'
7537 take that as color. Otherwise, try to determine the color
7539 look_at_corners_p
= 1;
7547 && NATNUMP (XCAR (how
)))
7549 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7553 if (i
== 3 && NILP (how
))
7555 char color_name
[30];
7556 XColor exact
, color
;
7559 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7561 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7562 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7565 look_at_corners_p
= 0;
7570 if (look_at_corners_p
)
7572 unsigned long corners
[4];
7575 /* Get the colors at the corners of ximg. */
7576 corners
[0] = XGetPixel (ximg
, 0, 0);
7577 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7578 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7579 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7581 /* Choose the most frequently found color as background. */
7582 for (i
= best_count
= 0; i
< 4; ++i
)
7586 for (j
= n
= 0; j
< 4; ++j
)
7587 if (corners
[i
] == corners
[j
])
7591 bg
= corners
[i
], best_count
= n
;
7595 /* Set all bits in mask_img to 1 whose color in ximg is different
7596 from the background color bg. */
7597 for (y
= 0; y
< img
->height
; ++y
)
7598 for (x
= 0; x
< img
->width
; ++x
)
7599 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7601 /* Put mask_img into img->mask. */
7602 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7603 x_destroy_x_image (mask_img
);
7604 XDestroyImage (ximg
);
7612 /***********************************************************************
7613 PBM (mono, gray, color)
7614 ***********************************************************************/
7616 static int pbm_image_p
P_ ((Lisp_Object object
));
7617 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7618 static int pbm_scan_number
P_ ((FILE *fp
));
7620 /* The symbol `pbm' identifying images of this type. */
7624 /* Indices of image specification fields in gs_format, below. */
7626 enum pbm_keyword_index
7638 /* Vector of image_keyword structures describing the format
7639 of valid user-defined image specifications. */
7641 static struct image_keyword pbm_format
[PBM_LAST
] =
7643 {":type", IMAGE_SYMBOL_VALUE
, 1},
7644 {":file", IMAGE_STRING_VALUE
, 1},
7645 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7646 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7647 {":relief", IMAGE_INTEGER_VALUE
, 0},
7648 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7649 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7652 /* Structure describing the image type `pbm'. */
7654 static struct image_type pbm_type
=
7664 /* Return non-zero if OBJECT is a valid PBM image specification. */
7667 pbm_image_p (object
)
7670 struct image_keyword fmt
[PBM_LAST
];
7672 bcopy (pbm_format
, fmt
, sizeof fmt
);
7674 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
, 0)
7675 || (fmt
[PBM_ASCENT
].count
7676 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7682 /* Scan a decimal number from PBM input file FP and return it. Value
7683 is -1 at end of file or if an error occurs. */
7686 pbm_scan_number (fp
)
7693 /* Skip white-space. */
7694 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
7699 /* Skip comment to end of line. */
7700 while ((c
= fgetc (fp
)) != EOF
&& c
!= '\n')
7703 else if (isdigit (c
))
7705 /* Read decimal number. */
7707 while ((c
= fgetc (fp
)) != EOF
&& isdigit (c
))
7708 val
= 10 * val
+ c
- '0';
7719 /* Load PBM image IMG for use on frame F. */
7729 int width
, height
, max_color_idx
= 0;
7731 Lisp_Object file
, specified_file
;
7732 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7733 struct gcpro gcpro1
;
7735 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7736 file
= x_find_image_file (specified_file
);
7738 if (!STRINGP (file
))
7740 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7745 fp
= fopen (XSTRING (file
)->data
, "r");
7752 /* Read first two characters. */
7753 if (fread (magic
, sizeof *magic
, 2, fp
) != 2)
7756 image_error ("Not a PBM image file: %s", file
, Qnil
);
7764 image_error ("Not a PBM image file: %s", file
, Qnil
);
7772 raw_p
= 0, type
= PBM_MONO
;
7776 raw_p
= 0, type
= PBM_GRAY
;
7780 raw_p
= 0, type
= PBM_COLOR
;
7784 raw_p
= 1, type
= PBM_MONO
;
7788 raw_p
= 1, type
= PBM_GRAY
;
7792 raw_p
= 1, type
= PBM_COLOR
;
7797 image_error ("Not a PBM image file: %s", file
, Qnil
);
7802 /* Read width, height, maximum color-component. Characters
7803 starting with `#' up to the end of a line are ignored. */
7804 width
= pbm_scan_number (fp
);
7805 height
= pbm_scan_number (fp
);
7807 if (type
!= PBM_MONO
)
7809 max_color_idx
= pbm_scan_number (fp
);
7810 if (raw_p
&& max_color_idx
> 255)
7811 max_color_idx
= 255;
7814 if (width
< 0 || height
< 0
7815 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7823 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0,
7824 &ximg
, &img
->pixmap
))
7832 /* Initialize the color hash table. */
7833 init_color_table ();
7835 if (type
== PBM_MONO
)
7839 for (y
= 0; y
< height
; ++y
)
7840 for (x
= 0; x
< width
; ++x
)
7850 g
= pbm_scan_number (fp
);
7852 XPutPixel (ximg
, x
, y
, (g
7853 ? FRAME_FOREGROUND_PIXEL (f
)
7854 : FRAME_BACKGROUND_PIXEL (f
)));
7859 for (y
= 0; y
< height
; ++y
)
7860 for (x
= 0; x
< width
; ++x
)
7864 if (type
== PBM_GRAY
)
7865 r
= g
= b
= raw_p
? fgetc (fp
) : pbm_scan_number (fp
);
7874 r
= pbm_scan_number (fp
);
7875 g
= pbm_scan_number (fp
);
7876 b
= pbm_scan_number (fp
);
7879 if (r
< 0 || g
< 0 || b
< 0)
7884 XDestroyImage (ximg
);
7886 image_error ("Invalid pixel value in file `%s'",
7892 /* RGB values are now in the range 0..max_color_idx.
7893 Scale this to the range 0..0xffff supported by X. */
7894 r
= (double) r
* 65535 / max_color_idx
;
7895 g
= (double) g
* 65535 / max_color_idx
;
7896 b
= (double) b
* 65535 / max_color_idx
;
7897 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7903 /* Store in IMG->colors the colors allocated for the image, and
7904 free the color table. */
7905 img
->colors
= colors_in_color_table (&img
->ncolors
);
7906 free_color_table ();
7908 /* Put the image into a pixmap. */
7909 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7910 x_destroy_x_image (ximg
);
7914 img
->height
= height
;
7922 /***********************************************************************
7924 ***********************************************************************/
7930 /* Function prototypes. */
7932 static int png_image_p
P_ ((Lisp_Object object
));
7933 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7935 /* The symbol `png' identifying images of this type. */
7939 /* Indices of image specification fields in png_format, below. */
7941 enum png_keyword_index
7953 /* Vector of image_keyword structures describing the format
7954 of valid user-defined image specifications. */
7956 static struct image_keyword png_format
[PNG_LAST
] =
7958 {":type", IMAGE_SYMBOL_VALUE
, 1},
7959 {":file", IMAGE_STRING_VALUE
, 1},
7960 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7961 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7962 {":relief", IMAGE_INTEGER_VALUE
, 0},
7963 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7964 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7967 /* Structure describing the image type `png'. */
7969 static struct image_type png_type
=
7979 /* Return non-zero if OBJECT is a valid PNG image specification. */
7982 png_image_p (object
)
7985 struct image_keyword fmt
[PNG_LAST
];
7986 bcopy (png_format
, fmt
, sizeof fmt
);
7988 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
, 1)
7989 || (fmt
[PNG_ASCENT
].count
7990 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7996 /* Error and warning handlers installed when the PNG library
8000 my_png_error (png_ptr
, msg
)
8001 png_struct
*png_ptr
;
8004 xassert (png_ptr
!= NULL
);
8005 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8006 longjmp (png_ptr
->jmpbuf
, 1);
8011 my_png_warning (png_ptr
, msg
)
8012 png_struct
*png_ptr
;
8015 xassert (png_ptr
!= NULL
);
8016 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8020 /* Load PNG image IMG for use on frame F. Value is non-zero if
8028 Lisp_Object file
, specified_file
;
8030 XImage
*ximg
, *mask_img
= NULL
;
8031 struct gcpro gcpro1
;
8032 png_struct
*png_ptr
= NULL
;
8033 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8036 png_byte
*pixels
= NULL
;
8037 png_byte
**rows
= NULL
;
8038 png_uint_32 width
, height
;
8039 int bit_depth
, color_type
, interlace_type
;
8041 png_uint_32 row_bytes
;
8044 double screen_gamma
, image_gamma
;
8047 /* Find out what file to load. */
8048 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8049 file
= x_find_image_file (specified_file
);
8051 if (!STRINGP (file
))
8053 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8058 /* Open the image file. */
8059 fp
= fopen (XSTRING (file
)->data
, "rb");
8062 image_error ("Cannot open image file %s", file
, Qnil
);
8068 /* Check PNG signature. */
8069 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8070 || !png_check_sig (sig
, sizeof sig
))
8072 image_error ("Not a PNG file: %s", file
, Qnil
);
8078 /* Initialize read and info structs for PNG lib. */
8079 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8080 my_png_error
, my_png_warning
);
8088 info_ptr
= png_create_info_struct (png_ptr
);
8091 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8097 end_info
= png_create_info_struct (png_ptr
);
8100 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8106 /* Set error jump-back. We come back here when the PNG library
8107 detects an error. */
8108 if (setjmp (png_ptr
->jmpbuf
))
8112 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8121 /* Read image info. */
8122 png_init_io (png_ptr
, fp
);
8123 png_set_sig_bytes (png_ptr
, sizeof sig
);
8124 png_read_info (png_ptr
, info_ptr
);
8125 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8126 &interlace_type
, NULL
, NULL
);
8128 /* If image contains simply transparency data, we prefer to
8129 construct a clipping mask. */
8130 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8135 /* This function is easier to write if we only have to handle
8136 one data format: RGB or RGBA with 8 bits per channel. Let's
8137 transform other formats into that format. */
8139 /* Strip more than 8 bits per channel. */
8140 if (bit_depth
== 16)
8141 png_set_strip_16 (png_ptr
);
8143 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8145 png_set_expand (png_ptr
);
8147 /* Convert grayscale images to RGB. */
8148 if (color_type
== PNG_COLOR_TYPE_GRAY
8149 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8150 png_set_gray_to_rgb (png_ptr
);
8152 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8153 gamma_str
= getenv ("SCREEN_GAMMA");
8154 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8156 /* Tell the PNG lib to handle gamma correction for us. */
8158 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8159 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8160 /* There is a special chunk in the image specifying the gamma. */
8161 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8164 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8165 /* Image contains gamma information. */
8166 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8168 /* Use a default of 0.5 for the image gamma. */
8169 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8171 /* Handle alpha channel by combining the image with a background
8172 color. Do this only if a real alpha channel is supplied. For
8173 simple transparency, we prefer a clipping mask. */
8176 png_color_16
*image_background
;
8178 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8179 /* Image contains a background color with which to
8180 combine the image. */
8181 png_set_background (png_ptr
, image_background
,
8182 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8185 /* Image does not contain a background color with which
8186 to combine the image data via an alpha channel. Use
8187 the frame's background instead. */
8190 png_color_16 frame_background
;
8193 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8194 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8195 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8198 bzero (&frame_background
, sizeof frame_background
);
8199 frame_background
.red
= color
.red
;
8200 frame_background
.green
= color
.green
;
8201 frame_background
.blue
= color
.blue
;
8203 png_set_background (png_ptr
, &frame_background
,
8204 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8208 /* Update info structure. */
8209 png_read_update_info (png_ptr
, info_ptr
);
8211 /* Get number of channels. Valid values are 1 for grayscale images
8212 and images with a palette, 2 for grayscale images with transparency
8213 information (alpha channel), 3 for RGB images, and 4 for RGB
8214 images with alpha channel, i.e. RGBA. If conversions above were
8215 sufficient we should only have 3 or 4 channels here. */
8216 channels
= png_get_channels (png_ptr
, info_ptr
);
8217 xassert (channels
== 3 || channels
== 4);
8219 /* Number of bytes needed for one row of the image. */
8220 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8222 /* Allocate memory for the image. */
8223 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8224 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8225 for (i
= 0; i
< height
; ++i
)
8226 rows
[i
] = pixels
+ i
* row_bytes
;
8228 /* Read the entire image. */
8229 png_read_image (png_ptr
, rows
);
8230 png_read_end (png_ptr
, info_ptr
);
8236 /* Create the X image and pixmap. */
8237 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8244 /* Create an image and pixmap serving as mask if the PNG image
8245 contains an alpha channel. */
8248 && !x_create_x_image_and_pixmap (f
, file
, width
, height
, 1,
8249 &mask_img
, &img
->mask
))
8251 x_destroy_x_image (ximg
);
8252 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8258 /* Fill the X image and mask from PNG data. */
8259 init_color_table ();
8261 for (y
= 0; y
< height
; ++y
)
8263 png_byte
*p
= rows
[y
];
8265 for (x
= 0; x
< width
; ++x
)
8272 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8274 /* An alpha channel, aka mask channel, associates variable
8275 transparency with an image. Where other image formats
8276 support binary transparency---fully transparent or fully
8277 opaque---PNG allows up to 254 levels of partial transparency.
8278 The PNG library implements partial transparency by combining
8279 the image with a specified background color.
8281 I'm not sure how to handle this here nicely: because the
8282 background on which the image is displayed may change, for
8283 real alpha channel support, it would be necessary to create
8284 a new image for each possible background.
8286 What I'm doing now is that a mask is created if we have
8287 boolean transparency information. Otherwise I'm using
8288 the frame's background color to combine the image with. */
8293 XPutPixel (mask_img
, x
, y
, *p
> 0);
8299 /* Remember colors allocated for this image. */
8300 img
->colors
= colors_in_color_table (&img
->ncolors
);
8301 free_color_table ();
8304 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8309 img
->height
= height
;
8311 /* Put the image into the pixmap, then free the X image and its buffer. */
8312 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8313 x_destroy_x_image (ximg
);
8315 /* Same for the mask. */
8318 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8319 x_destroy_x_image (mask_img
);
8327 #endif /* HAVE_PNG != 0 */
8331 /***********************************************************************
8333 ***********************************************************************/
8337 /* Work around a warning about HAVE_STDLIB_H being redefined in
8339 #ifdef HAVE_STDLIB_H
8340 #define HAVE_STDLIB_H_1
8341 #undef HAVE_STDLIB_H
8342 #endif /* HAVE_STLIB_H */
8344 #include <jpeglib.h>
8348 #ifdef HAVE_STLIB_H_1
8349 #define HAVE_STDLIB_H 1
8352 static int jpeg_image_p
P_ ((Lisp_Object object
));
8353 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8355 /* The symbol `jpeg' identifying images of this type. */
8359 /* Indices of image specification fields in gs_format, below. */
8361 enum jpeg_keyword_index
8369 JPEG_HEURISTIC_MASK
,
8373 /* Vector of image_keyword structures describing the format
8374 of valid user-defined image specifications. */
8376 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8378 {":type", IMAGE_SYMBOL_VALUE
, 1},
8379 {":file", IMAGE_STRING_VALUE
, 1},
8380 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8381 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8382 {":relief", IMAGE_INTEGER_VALUE
, 0},
8383 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8384 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8387 /* Structure describing the image type `jpeg'. */
8389 static struct image_type jpeg_type
=
8399 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8402 jpeg_image_p (object
)
8405 struct image_keyword fmt
[JPEG_LAST
];
8407 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8409 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
, 0)
8410 || (fmt
[JPEG_ASCENT
].count
8411 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8416 struct my_jpeg_error_mgr
8418 struct jpeg_error_mgr pub
;
8419 jmp_buf setjmp_buffer
;
8423 my_error_exit (cinfo
)
8426 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8427 longjmp (mgr
->setjmp_buffer
, 1);
8430 /* Load image IMG for use on frame F. Patterned after example.c
8431 from the JPEG lib. */
8438 struct jpeg_decompress_struct cinfo
;
8439 struct my_jpeg_error_mgr mgr
;
8440 Lisp_Object file
, specified_file
;
8443 int row_stride
, x
, y
;
8444 XImage
*ximg
= NULL
;
8446 unsigned long *colors
;
8448 struct gcpro gcpro1
;
8450 /* Open the JPEG file. */
8451 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8452 file
= x_find_image_file (specified_file
);
8454 if (!STRINGP (file
))
8456 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8461 fp
= fopen (XSTRING (file
)->data
, "r");
8464 image_error ("Cannot open `%s'", file
, Qnil
);
8469 /* Customize libjpeg's error handling to call my_error_exit
8470 when an error is detected. This function will perform
8472 mgr
.pub
.error_exit
= my_error_exit
;
8473 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8475 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8479 /* Called from my_error_exit. Display a JPEG error. */
8480 char buffer
[JMSG_LENGTH_MAX
];
8481 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8482 image_error ("Error reading JPEG file `%s': %s", file
,
8483 build_string (buffer
));
8486 /* Close the input file and destroy the JPEG object. */
8488 jpeg_destroy_decompress (&cinfo
);
8492 /* If we already have an XImage, free that. */
8493 x_destroy_x_image (ximg
);
8495 /* Free pixmap and colors. */
8496 x_clear_image (f
, img
);
8503 /* Create the JPEG decompression object. Let it read from fp.
8504 Read the JPEG image header. */
8505 jpeg_create_decompress (&cinfo
);
8506 jpeg_stdio_src (&cinfo
, fp
);
8507 jpeg_read_header (&cinfo
, TRUE
);
8509 /* Customize decompression so that color quantization will be used.
8510 Start decompression. */
8511 cinfo
.quantize_colors
= TRUE
;
8512 jpeg_start_decompress (&cinfo
);
8513 width
= img
->width
= cinfo
.output_width
;
8514 height
= img
->height
= cinfo
.output_height
;
8518 /* Create X image and pixmap. */
8519 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8523 longjmp (mgr
.setjmp_buffer
, 2);
8526 /* Allocate colors. When color quantization is used,
8527 cinfo.actual_number_of_colors has been set with the number of
8528 colors generated, and cinfo.colormap is a two-dimensional array
8529 of color indices in the range 0..cinfo.actual_number_of_colors.
8530 No more than 255 colors will be generated. */
8534 if (cinfo
.out_color_components
> 2)
8535 ir
= 0, ig
= 1, ib
= 2;
8536 else if (cinfo
.out_color_components
> 1)
8537 ir
= 0, ig
= 1, ib
= 0;
8539 ir
= 0, ig
= 0, ib
= 0;
8541 /* Use the color table mechanism because it handles colors that
8542 cannot be allocated nicely. Such colors will be replaced with
8543 a default color, and we don't have to care about which colors
8544 can be freed safely, and which can't. */
8545 init_color_table ();
8546 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8549 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8551 /* Multiply RGB values with 255 because X expects RGB values
8552 in the range 0..0xffff. */
8553 int r
= cinfo
.colormap
[ir
][i
] << 8;
8554 int g
= cinfo
.colormap
[ig
][i
] << 8;
8555 int b
= cinfo
.colormap
[ib
][i
] << 8;
8556 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8559 /* Remember those colors actually allocated. */
8560 img
->colors
= colors_in_color_table (&img
->ncolors
);
8561 free_color_table ();
8565 row_stride
= width
* cinfo
.output_components
;
8566 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8568 for (y
= 0; y
< height
; ++y
)
8570 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8571 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8572 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8576 jpeg_finish_decompress (&cinfo
);
8577 jpeg_destroy_decompress (&cinfo
);
8580 /* Put the image into the pixmap. */
8581 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8582 x_destroy_x_image (ximg
);
8588 #endif /* HAVE_JPEG */
8592 /***********************************************************************
8594 ***********************************************************************/
8600 static int tiff_image_p
P_ ((Lisp_Object object
));
8601 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8603 /* The symbol `tiff' identifying images of this type. */
8607 /* Indices of image specification fields in tiff_format, below. */
8609 enum tiff_keyword_index
8617 TIFF_HEURISTIC_MASK
,
8621 /* Vector of image_keyword structures describing the format
8622 of valid user-defined image specifications. */
8624 static struct image_keyword tiff_format
[TIFF_LAST
] =
8626 {":type", IMAGE_SYMBOL_VALUE
, 1},
8627 {":file", IMAGE_STRING_VALUE
, 1},
8628 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8629 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8630 {":relief", IMAGE_INTEGER_VALUE
, 0},
8631 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8632 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8635 /* Structure describing the image type `tiff'. */
8637 static struct image_type tiff_type
=
8647 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8650 tiff_image_p (object
)
8653 struct image_keyword fmt
[TIFF_LAST
];
8654 bcopy (tiff_format
, fmt
, sizeof fmt
);
8656 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
, 1)
8657 || (fmt
[TIFF_ASCENT
].count
8658 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8664 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8672 Lisp_Object file
, specified_file
;
8674 int width
, height
, x
, y
;
8678 struct gcpro gcpro1
;
8680 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8681 file
= x_find_image_file (specified_file
);
8683 if (!STRINGP (file
))
8685 image_error ("Cannot find image file %s", file
, Qnil
);
8690 /* Try to open the image file. */
8691 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8694 image_error ("Cannot open `%s'", file
, Qnil
);
8699 /* Get width and height of the image, and allocate a raster buffer
8700 of width x height 32-bit values. */
8701 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8702 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8703 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8705 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8709 image_error ("Error reading `%s'", file
, Qnil
);
8717 /* Create the X image and pixmap. */
8718 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8727 /* Initialize the color table. */
8728 init_color_table ();
8730 /* Process the pixel raster. Origin is in the lower-left corner. */
8731 for (y
= 0; y
< height
; ++y
)
8733 uint32
*row
= buf
+ y
* width
;
8735 for (x
= 0; x
< width
; ++x
)
8737 uint32 abgr
= row
[x
];
8738 int r
= TIFFGetR (abgr
) << 8;
8739 int g
= TIFFGetG (abgr
) << 8;
8740 int b
= TIFFGetB (abgr
) << 8;
8741 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8745 /* Remember the colors allocated for the image. Free the color table. */
8746 img
->colors
= colors_in_color_table (&img
->ncolors
);
8747 free_color_table ();
8749 /* Put the image into the pixmap, then free the X image and its buffer. */
8750 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8751 x_destroy_x_image (ximg
);
8756 img
->height
= height
;
8762 #endif /* HAVE_TIFF != 0 */
8766 /***********************************************************************
8768 ***********************************************************************/
8772 #include <gif_lib.h>
8774 static int gif_image_p
P_ ((Lisp_Object object
));
8775 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8777 /* The symbol `gif' identifying images of this type. */
8781 /* Indices of image specification fields in gif_format, below. */
8783 enum gif_keyword_index
8796 /* Vector of image_keyword structures describing the format
8797 of valid user-defined image specifications. */
8799 static struct image_keyword gif_format
[GIF_LAST
] =
8801 {":type", IMAGE_SYMBOL_VALUE
, 1},
8802 {":file", IMAGE_STRING_VALUE
, 1},
8803 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8804 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8805 {":relief", IMAGE_INTEGER_VALUE
, 0},
8806 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8807 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8808 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8811 /* Structure describing the image type `gif'. */
8813 static struct image_type gif_type
=
8823 /* Return non-zero if OBJECT is a valid GIF image specification. */
8826 gif_image_p (object
)
8829 struct image_keyword fmt
[GIF_LAST
];
8830 bcopy (gif_format
, fmt
, sizeof fmt
);
8832 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
, 1)
8833 || (fmt
[GIF_ASCENT
].count
8834 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8840 /* Load GIF image IMG for use on frame F. Value is non-zero if
8848 Lisp_Object file
, specified_file
;
8849 int rc
, width
, height
, x
, y
, i
;
8851 ColorMapObject
*gif_color_map
;
8852 unsigned long pixel_colors
[256];
8854 struct gcpro gcpro1
;
8856 int ino
, image_left
, image_top
, image_width
, image_height
;
8858 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8859 file
= x_find_image_file (specified_file
);
8861 if (!STRINGP (file
))
8863 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8868 /* Open the GIF file. */
8869 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8872 image_error ("Cannot open `%s'", file
, Qnil
);
8877 /* Read entire contents. */
8878 rc
= DGifSlurp (gif
);
8879 if (rc
== GIF_ERROR
)
8881 image_error ("Error reading `%s'", file
, Qnil
);
8882 DGifCloseFile (gif
);
8887 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8888 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8889 if (ino
>= gif
->ImageCount
)
8891 image_error ("Invalid image number `%s'", image
, Qnil
);
8892 DGifCloseFile (gif
);
8897 width
= img
->width
= gif
->SWidth
;
8898 height
= img
->height
= gif
->SHeight
;
8902 /* Create the X image and pixmap. */
8903 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8907 DGifCloseFile (gif
);
8912 /* Allocate colors. */
8913 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8915 gif_color_map
= gif
->SColorMap
;
8916 init_color_table ();
8917 bzero (pixel_colors
, sizeof pixel_colors
);
8919 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8921 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8922 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8923 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8924 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8927 img
->colors
= colors_in_color_table (&img
->ncolors
);
8928 free_color_table ();
8930 /* Clear the part of the screen image that are not covered by
8931 the image from the GIF file. Full animated GIF support
8932 requires more than can be done here (see the gif89 spec,
8933 disposal methods). Let's simply assume that the part
8934 not covered by a sub-image is in the frame's background color. */
8935 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8936 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8937 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8938 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8940 for (y
= 0; y
< image_top
; ++y
)
8941 for (x
= 0; x
< width
; ++x
)
8942 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8944 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8945 for (x
= 0; x
< width
; ++x
)
8946 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8948 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8950 for (x
= 0; x
< image_left
; ++x
)
8951 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8952 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8953 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8956 /* Read the GIF image into the X image. */
8957 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8959 static int interlace_start
[] = {0, 4, 2, 1};
8960 static int interlace_increment
[] = {8, 8, 4, 2};
8962 int row
= interlace_start
[0];
8966 for (y
= 0; y
< image_height
; y
++)
8968 if (row
>= image_height
)
8970 row
= interlace_start
[++pass
];
8971 while (row
>= image_height
)
8972 row
= interlace_start
[++pass
];
8975 for (x
= 0; x
< image_width
; x
++)
8978 = gif
->SavedImages
[ino
].RasterBits
[(y
* image_width
) + x
];
8979 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8983 row
+= interlace_increment
[pass
];
8988 for (y
= 0; y
< image_height
; ++y
)
8989 for (x
= 0; x
< image_width
; ++x
)
8991 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8992 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8996 DGifCloseFile (gif
);
8998 /* Put the image into the pixmap, then free the X image and its buffer. */
8999 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9000 x_destroy_x_image (ximg
);
9007 #endif /* HAVE_GIF != 0 */
9011 /***********************************************************************
9013 ***********************************************************************/
9015 static int gs_image_p
P_ ((Lisp_Object object
));
9016 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9017 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9019 /* The symbol `postscript' identifying images of this type. */
9021 Lisp_Object Qpostscript
;
9023 /* Keyword symbols. */
9025 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9027 /* Indices of image specification fields in gs_format, below. */
9029 enum gs_keyword_index
9045 /* Vector of image_keyword structures describing the format
9046 of valid user-defined image specifications. */
9048 static struct image_keyword gs_format
[GS_LAST
] =
9050 {":type", IMAGE_SYMBOL_VALUE
, 1},
9051 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9052 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9053 {":file", IMAGE_STRING_VALUE
, 1},
9054 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9055 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9056 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9057 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9058 {":relief", IMAGE_INTEGER_VALUE
, 0},
9059 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9060 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9063 /* Structure describing the image type `ghostscript'. */
9065 static struct image_type gs_type
=
9075 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9078 gs_clear_image (f
, img
)
9082 /* IMG->data.ptr_val may contain a recorded colormap. */
9083 xfree (img
->data
.ptr_val
);
9084 x_clear_image (f
, img
);
9088 /* Return non-zero if OBJECT is a valid Ghostscript image
9095 struct image_keyword fmt
[GS_LAST
];
9099 bcopy (gs_format
, fmt
, sizeof fmt
);
9101 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
, 1)
9102 || (fmt
[GS_ASCENT
].count
9103 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9106 /* Bounding box must be a list or vector containing 4 integers. */
9107 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9110 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9111 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9116 else if (VECTORP (tem
))
9118 if (XVECTOR (tem
)->size
!= 4)
9120 for (i
= 0; i
< 4; ++i
)
9121 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9131 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9140 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9141 struct gcpro gcpro1
, gcpro2
;
9143 double in_width
, in_height
;
9144 Lisp_Object pixel_colors
= Qnil
;
9146 /* Compute pixel size of pixmap needed from the given size in the
9147 image specification. Sizes in the specification are in pt. 1 pt
9148 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9150 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9151 in_width
= XFASTINT (pt_width
) / 72.0;
9152 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9153 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9154 in_height
= XFASTINT (pt_height
) / 72.0;
9155 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9157 /* Create the pixmap. */
9159 xassert (img
->pixmap
== 0);
9160 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9161 img
->width
, img
->height
,
9162 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9167 image_error ("Unable to create pixmap for `%s'",
9168 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9172 /* Call the loader to fill the pixmap. It returns a process object
9173 if successful. We do not record_unwind_protect here because
9174 other places in redisplay like calling window scroll functions
9175 don't either. Let the Lisp loader use `unwind-protect' instead. */
9176 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9178 sprintf (buffer
, "%lu %lu",
9179 (unsigned long) FRAME_X_WINDOW (f
),
9180 (unsigned long) img
->pixmap
);
9181 window_and_pixmap_id
= build_string (buffer
);
9183 sprintf (buffer
, "%lu %lu",
9184 FRAME_FOREGROUND_PIXEL (f
),
9185 FRAME_BACKGROUND_PIXEL (f
));
9186 pixel_colors
= build_string (buffer
);
9188 XSETFRAME (frame
, f
);
9189 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9191 loader
= intern ("gs-load-image");
9193 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9194 make_number (img
->width
),
9195 make_number (img
->height
),
9196 window_and_pixmap_id
,
9199 return PROCESSP (img
->data
.lisp_val
);
9203 /* Kill the Ghostscript process that was started to fill PIXMAP on
9204 frame F. Called from XTread_socket when receiving an event
9205 telling Emacs that Ghostscript has finished drawing. */
9208 x_kill_gs_process (pixmap
, f
)
9212 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9216 /* Find the image containing PIXMAP. */
9217 for (i
= 0; i
< c
->used
; ++i
)
9218 if (c
->images
[i
]->pixmap
== pixmap
)
9221 /* Kill the GS process. We should have found PIXMAP in the image
9222 cache and its image should contain a process object. */
9223 xassert (i
< c
->used
);
9225 xassert (PROCESSP (img
->data
.lisp_val
));
9226 Fkill_process (img
->data
.lisp_val
, Qnil
);
9227 img
->data
.lisp_val
= Qnil
;
9229 /* On displays with a mutable colormap, figure out the colors
9230 allocated for the image by looking at the pixels of an XImage for
9232 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9233 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9239 /* Try to get an XImage for img->pixmep. */
9240 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9241 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9246 /* Initialize the color table. */
9247 init_color_table ();
9249 /* For each pixel of the image, look its color up in the
9250 color table. After having done so, the color table will
9251 contain an entry for each color used by the image. */
9252 for (y
= 0; y
< img
->height
; ++y
)
9253 for (x
= 0; x
< img
->width
; ++x
)
9255 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9256 lookup_pixel_color (f
, pixel
);
9259 /* Record colors in the image. Free color table and XImage. */
9260 img
->colors
= colors_in_color_table (&img
->ncolors
);
9261 free_color_table ();
9262 XDestroyImage (ximg
);
9264 #if 0 /* This doesn't seem to be the case. If we free the colors
9265 here, we get a BadAccess later in x_clear_image when
9266 freeing the colors. */
9267 /* We have allocated colors once, but Ghostscript has also
9268 allocated colors on behalf of us. So, to get the
9269 reference counts right, free them once. */
9272 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9273 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9274 img
->colors
, img
->ncolors
, 0);
9279 image_error ("Cannot get X image of `%s'; colors will not be freed",
9280 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9288 /***********************************************************************
9290 ***********************************************************************/
9292 DEFUN ("x-change-window-property", Fx_change_window_property
,
9293 Sx_change_window_property
, 2, 3, 0,
9294 "Change window property PROP to VALUE on the X window of FRAME.\n\
9295 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9296 selected frame. Value is VALUE.")
9297 (prop
, value
, frame
)
9298 Lisp_Object frame
, prop
, value
;
9300 struct frame
*f
= check_x_frame (frame
);
9303 CHECK_STRING (prop
, 1);
9304 CHECK_STRING (value
, 2);
9307 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9308 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9309 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9310 XSTRING (value
)->data
, XSTRING (value
)->size
);
9312 /* Make sure the property is set when we return. */
9313 XFlush (FRAME_X_DISPLAY (f
));
9320 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9321 Sx_delete_window_property
, 1, 2, 0,
9322 "Remove window property PROP from X window of FRAME.\n\
9323 FRAME nil or omitted means use the selected frame. Value is PROP.")
9325 Lisp_Object prop
, frame
;
9327 struct frame
*f
= check_x_frame (frame
);
9330 CHECK_STRING (prop
, 1);
9332 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9333 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9335 /* Make sure the property is removed when we return. */
9336 XFlush (FRAME_X_DISPLAY (f
));
9343 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9345 "Value is the value of window property PROP on FRAME.\n\
9346 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9347 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9350 Lisp_Object prop
, frame
;
9352 struct frame
*f
= check_x_frame (frame
);
9355 Lisp_Object prop_value
= Qnil
;
9356 char *tmp_data
= NULL
;
9359 unsigned long actual_size
, bytes_remaining
;
9361 CHECK_STRING (prop
, 1);
9363 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9364 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9365 prop_atom
, 0, 0, False
, XA_STRING
,
9366 &actual_type
, &actual_format
, &actual_size
,
9367 &bytes_remaining
, (unsigned char **) &tmp_data
);
9370 int size
= bytes_remaining
;
9375 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9376 prop_atom
, 0, bytes_remaining
,
9378 &actual_type
, &actual_format
,
9379 &actual_size
, &bytes_remaining
,
9380 (unsigned char **) &tmp_data
);
9382 prop_value
= make_string (tmp_data
, size
);
9393 /***********************************************************************
9395 ***********************************************************************/
9397 /* The implementation partly follows a patch from
9398 F.Pierresteguy@frcl.bull.fr dated 1994. */
9400 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9401 the next X event is read and we enter XTread_socket again. Setting
9402 it to 1 inhibits busy-cursor display for direct commands. */
9404 int inhibit_busy_cursor
;
9406 /* Incremented with each call to x-display-busy-cursor.
9407 Decremented in x-undisplay-busy-cursor. */
9409 static int busy_count
;
9412 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9413 Sx_show_busy_cursor
, 0, 0, 0,
9414 "Show a busy cursor, if not already shown.\n\
9415 Each call to this function must be matched by a call to\n\
9416 x-undisplay-busy-cursor to make the busy pointer disappear again.")
9420 if (busy_count
== 1)
9422 Lisp_Object rest
, frame
;
9424 FOR_EACH_FRAME (rest
, frame
)
9425 if (FRAME_X_P (XFRAME (frame
)))
9427 struct frame
*f
= XFRAME (frame
);
9430 f
->output_data
.x
->busy_p
= 1;
9432 if (!f
->output_data
.x
->busy_window
)
9434 unsigned long mask
= CWCursor
;
9435 XSetWindowAttributes attrs
;
9437 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9438 f
->output_data
.x
->busy_window
9439 = XCreateWindow (FRAME_X_DISPLAY (f
),
9440 FRAME_OUTER_WINDOW (f
),
9441 0, 0, 32000, 32000, 0, 0,
9442 InputOnly
, CopyFromParent
,
9446 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9455 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9456 Sx_hide_busy_cursor
, 0, 1, 0,
9457 "Hide a busy-cursor.\n\
9458 A busy-cursor will actually be undisplayed when a matching\n\
9459 `x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
9460 issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
9461 not counting calls.")
9465 Lisp_Object rest
, frame
;
9467 if (busy_count
== 0)
9470 if (!NILP (force
) && busy_count
!= 0)
9474 if (busy_count
!= 0)
9477 FOR_EACH_FRAME (rest
, frame
)
9479 struct frame
*f
= XFRAME (frame
);
9482 /* Watch out for newly created frames. */
9483 && f
->output_data
.x
->busy_window
)
9487 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9488 /* Sync here because XTread_socket looks at the busy_p flag
9489 that is reset to zero below. */
9490 XSync (FRAME_X_DISPLAY (f
), False
);
9492 f
->output_data
.x
->busy_p
= 0;
9501 /***********************************************************************
9503 ***********************************************************************/
9505 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9508 /* The frame of a currently visible tooltip, or null. */
9510 struct frame
*tip_frame
;
9512 /* If non-nil, a timer started that hides the last tooltip when it
9515 Lisp_Object tip_timer
;
9518 /* Create a frame for a tooltip on the display described by DPYINFO.
9519 PARMS is a list of frame parameters. Value is the frame. */
9522 x_create_tip_frame (dpyinfo
, parms
)
9523 struct x_display_info
*dpyinfo
;
9527 Lisp_Object frame
, tem
;
9529 long window_prompting
= 0;
9531 int count
= specpdl_ptr
- specpdl
;
9532 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9537 /* Use this general default value to start with until we know if
9538 this frame has a specified name. */
9539 Vx_resource_name
= Vinvocation_name
;
9542 kb
= dpyinfo
->kboard
;
9544 kb
= &the_only_kboard
;
9547 /* Get the name of the frame to use for resource lookup. */
9548 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9550 && !EQ (name
, Qunbound
)
9552 error ("Invalid frame name--not a string or nil");
9553 Vx_resource_name
= name
;
9556 GCPRO3 (parms
, name
, frame
);
9557 tip_frame
= f
= make_frame (1);
9558 XSETFRAME (frame
, f
);
9559 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9561 f
->output_method
= output_x_window
;
9562 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9563 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9564 f
->output_data
.x
->icon_bitmap
= -1;
9565 f
->output_data
.x
->fontset
= -1;
9566 f
->icon_name
= Qnil
;
9567 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9569 FRAME_KBOARD (f
) = kb
;
9571 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9572 f
->output_data
.x
->explicit_parent
= 0;
9574 /* Set the name; the functions to which we pass f expect the name to
9576 if (EQ (name
, Qunbound
) || NILP (name
))
9578 f
->name
= build_string (dpyinfo
->x_id_name
);
9579 f
->explicit_name
= 0;
9584 f
->explicit_name
= 1;
9585 /* use the frame's title when getting resources for this frame. */
9586 specbind (Qx_resource_name
, name
);
9589 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9590 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9591 fs_register_fontset (f
, XCAR (tem
));
9593 /* Extract the window parameters from the supplied values
9594 that are needed to determine window geometry. */
9598 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9601 /* First, try whatever font the caller has specified. */
9604 tem
= Fquery_fontset (font
, Qnil
);
9606 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9608 font
= x_new_font (f
, XSTRING (font
)->data
);
9611 /* Try out a font which we hope has bold and italic variations. */
9612 if (!STRINGP (font
))
9613 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9614 if (!STRINGP (font
))
9615 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9616 if (! STRINGP (font
))
9617 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9618 if (! STRINGP (font
))
9619 /* This was formerly the first thing tried, but it finds too many fonts
9620 and takes too long. */
9621 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9622 /* If those didn't work, look for something which will at least work. */
9623 if (! STRINGP (font
))
9624 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9626 if (! STRINGP (font
))
9627 font
= build_string ("fixed");
9629 x_default_parameter (f
, parms
, Qfont
, font
,
9630 "font", "Font", RES_TYPE_STRING
);
9633 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9634 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9636 /* This defaults to 2 in order to match xterm. We recognize either
9637 internalBorderWidth or internalBorder (which is what xterm calls
9639 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9643 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9644 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9645 if (! EQ (value
, Qunbound
))
9646 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9650 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9651 "internalBorderWidth", "internalBorderWidth",
9654 /* Also do the stuff which must be set before the window exists. */
9655 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9656 "foreground", "Foreground", RES_TYPE_STRING
);
9657 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9658 "background", "Background", RES_TYPE_STRING
);
9659 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9660 "pointerColor", "Foreground", RES_TYPE_STRING
);
9661 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9662 "cursorColor", "Foreground", RES_TYPE_STRING
);
9663 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9664 "borderColor", "BorderColor", RES_TYPE_STRING
);
9666 /* Init faces before x_default_parameter is called for scroll-bar
9667 parameters because that function calls x_set_scroll_bar_width,
9668 which calls change_frame_size, which calls Fset_window_buffer,
9669 which runs hooks, which call Fvertical_motion. At the end, we
9670 end up in init_iterator with a null face cache, which should not
9672 init_frame_faces (f
);
9674 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9675 window_prompting
= x_figure_window_size (f
, parms
);
9677 if (window_prompting
& XNegative
)
9679 if (window_prompting
& YNegative
)
9680 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9682 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9686 if (window_prompting
& YNegative
)
9687 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9689 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9692 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9694 XSetWindowAttributes attrs
;
9698 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9699 /* Window managers looks at the override-redirect flag to
9700 determine whether or net to give windows a decoration (Xlib
9702 attrs
.override_redirect
= True
;
9703 attrs
.save_under
= True
;
9704 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9705 /* Arrange for getting MapNotify and UnmapNotify events. */
9706 attrs
.event_mask
= StructureNotifyMask
;
9708 = FRAME_X_WINDOW (f
)
9709 = XCreateWindow (FRAME_X_DISPLAY (f
),
9710 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9711 /* x, y, width, height */
9715 CopyFromParent
, InputOutput
, CopyFromParent
,
9722 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9723 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9724 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9725 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9726 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9727 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9729 /* Dimensions, especially f->height, must be done via change_frame_size.
9730 Change will not be effected unless different from the current
9735 SET_FRAME_WIDTH (f
, 0);
9736 change_frame_size (f
, height
, width
, 1, 0, 0);
9742 /* It is now ok to make the frame official even if we get an error
9743 below. And the frame needs to be on Vframe_list or making it
9744 visible won't work. */
9745 Vframe_list
= Fcons (frame
, Vframe_list
);
9747 /* Now that the frame is official, it counts as a reference to
9749 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9751 return unbind_to (count
, frame
);
9755 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9756 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9757 A tooltip window is a small X window displaying STRING at\n\
9758 the current mouse position.\n\
9759 FRAME nil or omitted means use the selected frame.\n\
9760 PARMS is an optional list of frame parameters which can be\n\
9761 used to change the tooltip's appearance.\n\
9762 Automatically hide the tooltip after TIMEOUT seconds.\n\
9763 TIMEOUT nil means use the default timeout of 5 seconds.")
9764 (string
, frame
, parms
, timeout
)
9765 Lisp_Object string
, frame
, parms
, timeout
;
9771 struct buffer
*old_buffer
;
9772 struct text_pos pos
;
9773 int i
, width
, height
;
9774 int root_x
, root_y
, win_x
, win_y
;
9776 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9777 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9778 int count
= specpdl_ptr
- specpdl
;
9780 specbind (Qinhibit_redisplay
, Qt
);
9782 GCPRO3 (string
, parms
, frame
);
9784 CHECK_STRING (string
, 0);
9785 f
= check_x_frame (frame
);
9787 timeout
= make_number (5);
9789 CHECK_NATNUM (timeout
, 2);
9791 /* Hide a previous tip, if any. */
9794 /* Add default values to frame parameters. */
9795 if (NILP (Fassq (Qname
, parms
)))
9796 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9797 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9798 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9799 if (NILP (Fassq (Qborder_width
, parms
)))
9800 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9801 if (NILP (Fassq (Qborder_color
, parms
)))
9802 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9803 if (NILP (Fassq (Qbackground_color
, parms
)))
9804 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9807 /* Create a frame for the tooltip, and record it in the global
9808 variable tip_frame. */
9809 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9810 tip_frame
= f
= XFRAME (frame
);
9812 /* Set up the frame's root window. Currently we use a size of 80
9813 columns x 40 lines. If someone wants to show a larger tip, he
9814 will loose. I don't think this is a realistic case. */
9815 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9816 w
->left
= w
->top
= make_number (0);
9820 w
->pseudo_window_p
= 1;
9822 /* Display the tooltip text in a temporary buffer. */
9823 buffer
= Fget_buffer_create (build_string (" *tip*"));
9824 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9825 old_buffer
= current_buffer
;
9826 set_buffer_internal_1 (XBUFFER (buffer
));
9828 Finsert (make_number (1), &string
);
9829 clear_glyph_matrix (w
->desired_matrix
);
9830 clear_glyph_matrix (w
->current_matrix
);
9831 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9832 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9834 /* Compute width and height of the tooltip. */
9836 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9838 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9842 /* Stop at the first empty row at the end. */
9843 if (!row
->enabled_p
|| !row
->displays_text_p
)
9846 /* Let the row go over the full width of the frame. */
9847 row
->full_width_p
= 1;
9849 /* There's a glyph at the end of rows that is use to place
9850 the cursor there. Don't include the width of this glyph. */
9851 if (row
->used
[TEXT_AREA
])
9853 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9854 row_width
= row
->pixel_width
- last
->pixel_width
;
9857 row_width
= row
->pixel_width
;
9859 height
+= row
->height
;
9860 width
= max (width
, row_width
);
9863 /* Add the frame's internal border to the width and height the X
9864 window should have. */
9865 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9866 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9868 /* Move the tooltip window where the mouse pointer is. Resize and
9871 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9872 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9873 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9874 root_x
+ 5, root_y
- height
- 5, width
, height
);
9875 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9878 /* Draw into the window. */
9879 w
->must_be_updated_p
= 1;
9880 update_single_window (w
, 1);
9882 /* Restore original current buffer. */
9883 set_buffer_internal_1 (old_buffer
);
9884 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9886 /* Let the tip disappear after timeout seconds. */
9887 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9888 intern ("x-hide-tip"));
9890 return unbind_to (count
, Qnil
);
9894 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9895 "Hide the current tooltip window, if there is any.\n\
9896 Value is t is tooltip was open, nil otherwise.")
9899 int count
= specpdl_ptr
- specpdl
;
9902 specbind (Qinhibit_redisplay
, Qt
);
9904 if (!NILP (tip_timer
))
9906 call1 (intern ("cancel-timer"), tip_timer
);
9914 XSETFRAME (frame
, tip_frame
);
9915 Fdelete_frame (frame
, Qt
);
9920 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9925 /***********************************************************************
9926 File selection dialog
9927 ***********************************************************************/
9931 /* Callback for "OK" and "Cancel" on file selection dialog. */
9934 file_dialog_cb (widget
, client_data
, call_data
)
9936 XtPointer call_data
, client_data
;
9938 int *result
= (int *) client_data
;
9939 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9940 *result
= cb
->reason
;
9944 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9945 "Read file name, prompting with PROMPT in directory DIR.\n\
9946 Use a file selection dialog.\n\
9947 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9948 specified. Don't let the user enter a file name in the file\n\
9949 selection dialog's entry field, if MUSTMATCH is non-nil.")
9950 (prompt
, dir
, default_filename
, mustmatch
)
9951 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9954 struct frame
*f
= SELECTED_FRAME ();
9955 Lisp_Object file
= Qnil
;
9956 Widget dialog
, text
, list
, help
;
9959 extern XtAppContext Xt_app_con
;
9961 XmString dir_xmstring
, pattern_xmstring
;
9962 int popup_activated_flag
;
9963 int count
= specpdl_ptr
- specpdl
;
9964 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9966 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9967 CHECK_STRING (prompt
, 0);
9968 CHECK_STRING (dir
, 1);
9970 /* Prevent redisplay. */
9971 specbind (Qinhibit_redisplay
, Qt
);
9975 /* Create the dialog with PROMPT as title, using DIR as initial
9976 directory and using "*" as pattern. */
9977 dir
= Fexpand_file_name (dir
, Qnil
);
9978 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9979 pattern_xmstring
= XmStringCreateLocalized ("*");
9981 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9982 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9983 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9984 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9985 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9986 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9988 XmStringFree (dir_xmstring
);
9989 XmStringFree (pattern_xmstring
);
9991 /* Add callbacks for OK and Cancel. */
9992 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9993 (XtPointer
) &result
);
9994 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9995 (XtPointer
) &result
);
9997 /* Disable the help button since we can't display help. */
9998 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9999 XtSetSensitive (help
, False
);
10001 /* Mark OK button as default. */
10002 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10003 XmNshowAsDefault
, True
, NULL
);
10005 /* If MUSTMATCH is non-nil, disable the file entry field of the
10006 dialog, so that the user must select a file from the files list
10007 box. We can't remove it because we wouldn't have a way to get at
10008 the result file name, then. */
10009 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10010 if (!NILP (mustmatch
))
10013 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10014 XtSetSensitive (text
, False
);
10015 XtSetSensitive (label
, False
);
10018 /* Manage the dialog, so that list boxes get filled. */
10019 XtManageChild (dialog
);
10021 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10022 must include the path for this to work. */
10023 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10024 if (STRINGP (default_filename
))
10026 XmString default_xmstring
;
10030 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10032 if (!XmListItemExists (list
, default_xmstring
))
10034 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10035 XmListAddItem (list
, default_xmstring
, 0);
10039 item_pos
= XmListItemPos (list
, default_xmstring
);
10040 XmStringFree (default_xmstring
);
10042 /* Select the item and scroll it into view. */
10043 XmListSelectPos (list
, item_pos
, True
);
10044 XmListSetPos (list
, item_pos
);
10047 /* Process all events until the user presses Cancel or OK. */
10048 for (result
= 0; result
== 0;)
10051 Widget widget
, parent
;
10053 XtAppNextEvent (Xt_app_con
, &event
);
10055 /* See if the receiver of the event is one of the widgets of
10056 the file selection dialog. If so, dispatch it. If not,
10058 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10060 while (parent
&& parent
!= dialog
)
10061 parent
= XtParent (parent
);
10063 if (parent
== dialog
10064 || (event
.type
== Expose
10065 && !process_expose_from_menu (event
)))
10066 XtDispatchEvent (&event
);
10069 /* Get the result. */
10070 if (result
== XmCR_OK
)
10075 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10076 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10077 XmStringFree (text
);
10078 file
= build_string (data
);
10085 XtUnmanageChild (dialog
);
10086 XtDestroyWidget (dialog
);
10090 /* Make "Cancel" equivalent to C-g. */
10092 Fsignal (Qquit
, Qnil
);
10094 return unbind_to (count
, file
);
10097 #endif /* USE_MOTIF */
10100 /***********************************************************************
10102 ***********************************************************************/
10106 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10107 "Value is non-nil if SPEC is a valid image specification.")
10111 return valid_image_p (spec
) ? Qt
: Qnil
;
10115 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10121 if (valid_image_p (spec
))
10122 id
= lookup_image (SELECTED_FRAME (), spec
);
10124 debug_print (spec
);
10125 return make_number (id
);
10128 #endif /* GLYPH_DEBUG != 0 */
10132 /***********************************************************************
10134 ***********************************************************************/
10139 /* This is zero if not using X windows. */
10142 /* The section below is built by the lisp expression at the top of the file,
10143 just above where these variables are declared. */
10144 /*&&& init symbols here &&&*/
10145 Qauto_raise
= intern ("auto-raise");
10146 staticpro (&Qauto_raise
);
10147 Qauto_lower
= intern ("auto-lower");
10148 staticpro (&Qauto_lower
);
10149 Qbar
= intern ("bar");
10151 Qborder_color
= intern ("border-color");
10152 staticpro (&Qborder_color
);
10153 Qborder_width
= intern ("border-width");
10154 staticpro (&Qborder_width
);
10155 Qbox
= intern ("box");
10157 Qcursor_color
= intern ("cursor-color");
10158 staticpro (&Qcursor_color
);
10159 Qcursor_type
= intern ("cursor-type");
10160 staticpro (&Qcursor_type
);
10161 Qgeometry
= intern ("geometry");
10162 staticpro (&Qgeometry
);
10163 Qicon_left
= intern ("icon-left");
10164 staticpro (&Qicon_left
);
10165 Qicon_top
= intern ("icon-top");
10166 staticpro (&Qicon_top
);
10167 Qicon_type
= intern ("icon-type");
10168 staticpro (&Qicon_type
);
10169 Qicon_name
= intern ("icon-name");
10170 staticpro (&Qicon_name
);
10171 Qinternal_border_width
= intern ("internal-border-width");
10172 staticpro (&Qinternal_border_width
);
10173 Qleft
= intern ("left");
10174 staticpro (&Qleft
);
10175 Qright
= intern ("right");
10176 staticpro (&Qright
);
10177 Qmouse_color
= intern ("mouse-color");
10178 staticpro (&Qmouse_color
);
10179 Qnone
= intern ("none");
10180 staticpro (&Qnone
);
10181 Qparent_id
= intern ("parent-id");
10182 staticpro (&Qparent_id
);
10183 Qscroll_bar_width
= intern ("scroll-bar-width");
10184 staticpro (&Qscroll_bar_width
);
10185 Qsuppress_icon
= intern ("suppress-icon");
10186 staticpro (&Qsuppress_icon
);
10187 Qundefined_color
= intern ("undefined-color");
10188 staticpro (&Qundefined_color
);
10189 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10190 staticpro (&Qvertical_scroll_bars
);
10191 Qvisibility
= intern ("visibility");
10192 staticpro (&Qvisibility
);
10193 Qwindow_id
= intern ("window-id");
10194 staticpro (&Qwindow_id
);
10195 Qouter_window_id
= intern ("outer-window-id");
10196 staticpro (&Qouter_window_id
);
10197 Qx_frame_parameter
= intern ("x-frame-parameter");
10198 staticpro (&Qx_frame_parameter
);
10199 Qx_resource_name
= intern ("x-resource-name");
10200 staticpro (&Qx_resource_name
);
10201 Quser_position
= intern ("user-position");
10202 staticpro (&Quser_position
);
10203 Quser_size
= intern ("user-size");
10204 staticpro (&Quser_size
);
10205 Qdisplay
= intern ("display");
10206 staticpro (&Qdisplay
);
10207 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10208 staticpro (&Qscroll_bar_foreground
);
10209 Qscroll_bar_background
= intern ("scroll-bar-background");
10210 staticpro (&Qscroll_bar_background
);
10211 Qscreen_gamma
= intern ("screen-gamma");
10212 staticpro (&Qscreen_gamma
);
10213 /* This is the end of symbol initialization. */
10215 Qlaplace
= intern ("laplace");
10216 staticpro (&Qlaplace
);
10218 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10219 staticpro (&Qface_set_after_frame_default
);
10221 Fput (Qundefined_color
, Qerror_conditions
,
10222 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10223 Fput (Qundefined_color
, Qerror_message
,
10224 build_string ("Undefined color"));
10226 init_x_parm_symbols ();
10228 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10229 "List of directories to search for bitmap files for X.");
10230 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10232 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10233 "The shape of the pointer when over text.\n\
10234 Changing the value does not affect existing frames\n\
10235 unless you set the mouse color.");
10236 Vx_pointer_shape
= Qnil
;
10238 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10239 "The name Emacs uses to look up X resources.\n\
10240 `x-get-resource' uses this as the first component of the instance name\n\
10241 when requesting resource values.\n\
10242 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10243 was invoked, or to the value specified with the `-name' or `-rn'\n\
10244 switches, if present.\n\
10246 It may be useful to bind this variable locally around a call\n\
10247 to `x-get-resource'. See also the variable `x-resource-class'.");
10248 Vx_resource_name
= Qnil
;
10250 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10251 "The class Emacs uses to look up X resources.\n\
10252 `x-get-resource' uses this as the first component of the instance class\n\
10253 when requesting resource values.\n\
10254 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10256 Setting this variable permanently is not a reasonable thing to do,\n\
10257 but binding this variable locally around a call to `x-get-resource'\n\
10258 is a reasonable practice. See also the variable `x-resource-name'.");
10259 Vx_resource_class
= build_string (EMACS_CLASS
);
10261 #if 0 /* This doesn't really do anything. */
10262 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10263 "The shape of the pointer when not over text.\n\
10264 This variable takes effect when you create a new frame\n\
10265 or when you set the mouse color.");
10267 Vx_nontext_pointer_shape
= Qnil
;
10269 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10270 "The shape of the pointer when Emacs is busy.\n\
10271 This variable takes effect when you create a new frame\n\
10272 or when you set the mouse color.");
10273 Vx_busy_pointer_shape
= Qnil
;
10275 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10276 "Non-zero means Emacs displays a busy cursor on window systems.");
10277 display_busy_cursor_p
= 1;
10279 #if 0 /* This doesn't really do anything. */
10280 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10281 "The shape of the pointer when over the mode line.\n\
10282 This variable takes effect when you create a new frame\n\
10283 or when you set the mouse color.");
10285 Vx_mode_pointer_shape
= Qnil
;
10287 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10288 &Vx_sensitive_text_pointer_shape
,
10289 "The shape of the pointer when over mouse-sensitive text.\n\
10290 This variable takes effect when you create a new frame\n\
10291 or when you set the mouse color.");
10292 Vx_sensitive_text_pointer_shape
= Qnil
;
10294 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10295 "A string indicating the foreground color of the cursor box.");
10296 Vx_cursor_fore_pixel
= Qnil
;
10298 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10299 "Non-nil if no X window manager is in use.\n\
10300 Emacs doesn't try to figure this out; this is always nil\n\
10301 unless you set it to something else.");
10302 /* We don't have any way to find this out, so set it to nil
10303 and maybe the user would like to set it to t. */
10304 Vx_no_window_manager
= Qnil
;
10306 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10307 &Vx_pixel_size_width_font_regexp
,
10308 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10310 Since Emacs gets width of a font matching with this regexp from\n\
10311 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10312 such a font. This is especially effective for such large fonts as\n\
10313 Chinese, Japanese, and Korean.");
10314 Vx_pixel_size_width_font_regexp
= Qnil
;
10316 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10317 "Time after which cached images are removed from the cache.\n\
10318 When an image has not been displayed this many seconds, remove it\n\
10319 from the image cache. Value must be an integer or nil with nil\n\
10320 meaning don't clear the cache.");
10321 Vimage_cache_eviction_delay
= make_number (30 * 60);
10323 DEFVAR_LISP ("image-types", &Vimage_types
,
10324 "List of supported image types.\n\
10325 Each element of the list is a symbol for a supported image type.");
10326 Vimage_types
= Qnil
;
10328 #ifdef USE_X_TOOLKIT
10329 Fprovide (intern ("x-toolkit"));
10332 Fprovide (intern ("motif"));
10335 defsubr (&Sx_get_resource
);
10337 /* X window properties. */
10338 defsubr (&Sx_change_window_property
);
10339 defsubr (&Sx_delete_window_property
);
10340 defsubr (&Sx_window_property
);
10343 defsubr (&Sx_draw_rectangle
);
10344 defsubr (&Sx_erase_rectangle
);
10345 defsubr (&Sx_contour_region
);
10346 defsubr (&Sx_uncontour_region
);
10348 defsubr (&Sx_display_color_p
);
10349 defsubr (&Sx_display_grayscale_p
);
10350 defsubr (&Sx_color_defined_p
);
10351 defsubr (&Sx_color_values
);
10352 defsubr (&Sx_server_max_request_size
);
10353 defsubr (&Sx_server_vendor
);
10354 defsubr (&Sx_server_version
);
10355 defsubr (&Sx_display_pixel_width
);
10356 defsubr (&Sx_display_pixel_height
);
10357 defsubr (&Sx_display_mm_width
);
10358 defsubr (&Sx_display_mm_height
);
10359 defsubr (&Sx_display_screens
);
10360 defsubr (&Sx_display_planes
);
10361 defsubr (&Sx_display_color_cells
);
10362 defsubr (&Sx_display_visual_class
);
10363 defsubr (&Sx_display_backing_store
);
10364 defsubr (&Sx_display_save_under
);
10366 defsubr (&Sx_rebind_key
);
10367 defsubr (&Sx_rebind_keys
);
10368 defsubr (&Sx_track_pointer
);
10369 defsubr (&Sx_grab_pointer
);
10370 defsubr (&Sx_ungrab_pointer
);
10372 defsubr (&Sx_parse_geometry
);
10373 defsubr (&Sx_create_frame
);
10375 defsubr (&Sx_horizontal_line
);
10377 defsubr (&Sx_open_connection
);
10378 defsubr (&Sx_close_connection
);
10379 defsubr (&Sx_display_list
);
10380 defsubr (&Sx_synchronize
);
10382 /* Setting callback functions for fontset handler. */
10383 get_font_info_func
= x_get_font_info
;
10385 #if 0 /* This function pointer doesn't seem to be used anywhere.
10386 And the pointer assigned has the wrong type, anyway. */
10387 list_fonts_func
= x_list_fonts
;
10390 load_font_func
= x_load_font
;
10391 find_ccl_program_func
= x_find_ccl_program
;
10392 query_font_func
= x_query_font
;
10393 set_frame_fontset_func
= x_set_font
;
10394 check_window_system_func
= check_x
;
10397 Qxbm
= intern ("xbm");
10399 QCtype
= intern (":type");
10400 staticpro (&QCtype
);
10401 QCalgorithm
= intern (":algorithm");
10402 staticpro (&QCalgorithm
);
10403 QCheuristic_mask
= intern (":heuristic-mask");
10404 staticpro (&QCheuristic_mask
);
10405 QCcolor_symbols
= intern (":color-symbols");
10406 staticpro (&QCcolor_symbols
);
10407 QCdata
= intern (":data");
10408 staticpro (&QCdata
);
10409 QCascent
= intern (":ascent");
10410 staticpro (&QCascent
);
10411 QCmargin
= intern (":margin");
10412 staticpro (&QCmargin
);
10413 QCrelief
= intern (":relief");
10414 staticpro (&QCrelief
);
10415 Qpostscript
= intern ("postscript");
10416 staticpro (&Qpostscript
);
10417 QCloader
= intern (":loader");
10418 staticpro (&QCloader
);
10419 QCbounding_box
= intern (":bounding-box");
10420 staticpro (&QCbounding_box
);
10421 QCpt_width
= intern (":pt-width");
10422 staticpro (&QCpt_width
);
10423 QCpt_height
= intern (":pt-height");
10424 staticpro (&QCpt_height
);
10425 QCindex
= intern (":index");
10426 staticpro (&QCindex
);
10427 Qpbm
= intern ("pbm");
10431 Qxpm
= intern ("xpm");
10436 Qjpeg
= intern ("jpeg");
10437 staticpro (&Qjpeg
);
10441 Qtiff
= intern ("tiff");
10442 staticpro (&Qtiff
);
10446 Qgif
= intern ("gif");
10451 Qpng
= intern ("png");
10455 defsubr (&Sclear_image_cache
);
10458 defsubr (&Simagep
);
10459 defsubr (&Slookup_image
);
10463 defsubr (&Sx_show_busy_cursor
);
10464 defsubr (&Sx_hide_busy_cursor
);
10466 inhibit_busy_cursor
= 0;
10468 defsubr (&Sx_show_tip
);
10469 defsubr (&Sx_hide_tip
);
10470 staticpro (&tip_timer
);
10474 defsubr (&Sx_file_dialog
);
10482 image_types
= NULL
;
10483 Vimage_types
= Qnil
;
10485 define_image_type (&xbm_type
);
10486 define_image_type (&gs_type
);
10487 define_image_type (&pbm_type
);
10490 define_image_type (&xpm_type
);
10494 define_image_type (&jpeg_type
);
10498 define_image_type (&tiff_type
);
10502 define_image_type (&gif_type
);
10506 define_image_type (&png_type
);
10510 #endif /* HAVE_X_WINDOWS */