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"
57 /* On some systems, the character-composition stuff is broken in X11R5. */
59 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
60 #ifdef X11R5_INHIBIT_I18N
61 #define X_I18N_INHIBITED
66 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
67 #include "bitmaps/gray.xbm"
69 #include <X11/bitmaps/gray>
72 #include "[.bitmaps]gray.xbm"
76 #include <X11/Shell.h>
79 #include <X11/Xaw/Paned.h>
80 #include <X11/Xaw/Label.h>
81 #endif /* USE_MOTIF */
84 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
93 #include "../lwlib/lwlib.h"
97 #include <Xm/DialogS.h>
98 #include <Xm/FileSB.h>
101 /* Do the EDITRES protocol if running X11R5
102 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
104 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
106 extern void _XEditResCheckMessages ();
107 #endif /* R5 + Athena */
109 /* Unique id counter for widgets created by the Lucid Widget Library. */
111 extern LWLIB_ID widget_id_tick
;
114 /* This is part of a kludge--see lwlib/xlwmenu.c. */
115 extern XFontStruct
*xlwmenu_default_font
;
118 extern void free_frame_menubar ();
119 extern double atof ();
121 #endif /* USE_X_TOOLKIT */
123 #define min(a,b) ((a) < (b) ? (a) : (b))
124 #define max(a,b) ((a) > (b) ? (a) : (b))
127 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
129 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
132 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
133 it, and including `bitmaps/gray' more than once is a problem when
134 config.h defines `static' as an empty replacement string. */
136 int gray_bitmap_width
= gray_width
;
137 int gray_bitmap_height
= gray_height
;
138 unsigned char *gray_bitmap_bits
= gray_bits
;
140 /* The name we're using in resource queries. Most often "emacs". */
142 Lisp_Object Vx_resource_name
;
144 /* The application class we're using in resource queries.
147 Lisp_Object Vx_resource_class
;
149 /* Non-zero means we're allowed to display a busy cursor. */
151 int display_busy_cursor_p
;
153 /* The background and shape of the mouse pointer, and shape when not
154 over text or in the modeline. */
156 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
157 Lisp_Object Vx_busy_pointer_shape
;
159 /* The shape when over mouse-sensitive text. */
161 Lisp_Object Vx_sensitive_text_pointer_shape
;
163 /* Color of chars displayed in cursor box. */
165 Lisp_Object Vx_cursor_fore_pixel
;
167 /* Nonzero if using X. */
171 /* Non nil if no window manager is in use. */
173 Lisp_Object Vx_no_window_manager
;
175 /* Search path for bitmap files. */
177 Lisp_Object Vx_bitmap_file_path
;
179 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
181 Lisp_Object Vx_pixel_size_width_font_regexp
;
183 /* Evaluate this expression to rebuild the section of syms_of_xfns
184 that initializes and staticpros the symbols declared below. Note
185 that Emacs 18 has a bug that keeps C-x C-e from being able to
186 evaluate this expression.
189 ;; Accumulate a list of the symbols we want to initialize from the
190 ;; declarations at the top of the file.
191 (goto-char (point-min))
192 (search-forward "/\*&&& symbols declared here &&&*\/\n")
194 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
196 (cons (buffer-substring (match-beginning 1) (match-end 1))
199 (setq symbol-list (nreverse symbol-list))
200 ;; Delete the section of syms_of_... where we initialize the symbols.
201 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
202 (let ((start (point)))
203 (while (looking-at "^ Q")
205 (kill-region start (point)))
206 ;; Write a new symbol initialization section.
208 (insert (format " %s = intern (\"" (car symbol-list)))
209 (let ((start (point)))
210 (insert (substring (car symbol-list) 1))
211 (subst-char-in-region start (point) ?_ ?-))
212 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
213 (setq symbol-list (cdr symbol-list)))))
217 /*&&& symbols declared here &&&*/
218 Lisp_Object Qauto_raise
;
219 Lisp_Object Qauto_lower
;
221 Lisp_Object Qborder_color
;
222 Lisp_Object Qborder_width
;
224 Lisp_Object Qcursor_color
;
225 Lisp_Object Qcursor_type
;
226 Lisp_Object Qgeometry
;
227 Lisp_Object Qicon_left
;
228 Lisp_Object Qicon_top
;
229 Lisp_Object Qicon_type
;
230 Lisp_Object Qicon_name
;
231 Lisp_Object Qinternal_border_width
;
234 Lisp_Object Qmouse_color
;
236 Lisp_Object Qouter_window_id
;
237 Lisp_Object Qparent_id
;
238 Lisp_Object Qscroll_bar_width
;
239 Lisp_Object Qsuppress_icon
;
240 extern Lisp_Object Qtop
;
241 Lisp_Object Qundefined_color
;
242 Lisp_Object Qvertical_scroll_bars
;
243 Lisp_Object Qvisibility
;
244 Lisp_Object Qwindow_id
;
245 Lisp_Object Qx_frame_parameter
;
246 Lisp_Object Qx_resource_name
;
247 Lisp_Object Quser_position
;
248 Lisp_Object Quser_size
;
249 extern Lisp_Object Qdisplay
;
250 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
251 Lisp_Object Qscreen_gamma
;
253 /* The below are defined in frame.c. */
255 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
256 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
257 extern Lisp_Object Qtool_bar_lines
;
259 extern Lisp_Object Vwindow_system_version
;
261 Lisp_Object Qface_set_after_frame_default
;
264 /* Error if we are not connected to X. */
270 error ("X windows are not in use or not initialized");
273 /* Nonzero if we can use mouse menus.
274 You should not call this unless HAVE_MENUS is defined. */
282 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
283 and checking validity for X. */
286 check_x_frame (frame
)
292 frame
= selected_frame
;
293 CHECK_LIVE_FRAME (frame
, 0);
296 error ("Non-X frame used");
300 /* Let the user specify an X display with a frame.
301 nil stands for the selected frame--or, if that is not an X frame,
302 the first X display on the list. */
304 static struct x_display_info
*
305 check_x_display_info (frame
)
310 struct frame
*sf
= XFRAME (selected_frame
);
312 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
313 return FRAME_X_DISPLAY_INFO (sf
);
314 else if (x_display_list
!= 0)
315 return x_display_list
;
317 error ("X windows are not in use or not initialized");
319 else if (STRINGP (frame
))
320 return x_display_info_for_name (frame
);
325 CHECK_LIVE_FRAME (frame
, 0);
328 error ("Non-X frame used");
329 return FRAME_X_DISPLAY_INFO (f
);
334 /* Return the Emacs frame-object corresponding to an X window.
335 It could be the frame's main window or an icon window. */
337 /* This function can be called during GC, so use GC_xxx type test macros. */
340 x_window_to_frame (dpyinfo
, wdesc
)
341 struct x_display_info
*dpyinfo
;
344 Lisp_Object tail
, frame
;
347 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
350 if (!GC_FRAMEP (frame
))
353 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
356 if ((f
->output_data
.x
->edit_widget
357 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
358 /* A tooltip frame? */
359 || (!f
->output_data
.x
->edit_widget
360 && FRAME_X_WINDOW (f
) == wdesc
)
361 || f
->output_data
.x
->icon_desc
== wdesc
)
363 #else /* not USE_X_TOOLKIT */
364 if (FRAME_X_WINDOW (f
) == wdesc
365 || f
->output_data
.x
->icon_desc
== wdesc
)
367 #endif /* not USE_X_TOOLKIT */
373 /* Like x_window_to_frame but also compares the window with the widget's
377 x_any_window_to_frame (dpyinfo
, wdesc
)
378 struct x_display_info
*dpyinfo
;
381 Lisp_Object tail
, frame
;
385 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
388 if (!GC_FRAMEP (frame
))
391 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
393 x
= f
->output_data
.x
;
394 /* This frame matches if the window is any of its widgets. */
397 if (wdesc
== XtWindow (x
->widget
)
398 || wdesc
== XtWindow (x
->column_widget
)
399 || wdesc
== XtWindow (x
->edit_widget
))
401 /* Match if the window is this frame's menubar. */
402 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
405 else if (FRAME_X_WINDOW (f
) == wdesc
)
406 /* A tooltip frame. */
412 /* Likewise, but exclude the menu bar widget. */
415 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
416 struct x_display_info
*dpyinfo
;
419 Lisp_Object tail
, frame
;
423 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
426 if (!GC_FRAMEP (frame
))
429 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
431 x
= f
->output_data
.x
;
432 /* This frame matches if the window is any of its widgets. */
435 if (wdesc
== XtWindow (x
->widget
)
436 || wdesc
== XtWindow (x
->column_widget
)
437 || wdesc
== XtWindow (x
->edit_widget
))
440 else if (FRAME_X_WINDOW (f
) == wdesc
)
441 /* A tooltip frame. */
447 /* Likewise, but consider only the menu bar widget. */
450 x_menubar_window_to_frame (dpyinfo
, wdesc
)
451 struct x_display_info
*dpyinfo
;
454 Lisp_Object tail
, frame
;
458 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
461 if (!GC_FRAMEP (frame
))
464 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
466 x
= f
->output_data
.x
;
467 /* Match if the window is this frame's menubar. */
468 if (x
->menubar_widget
469 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
475 /* Return the frame whose principal (outermost) window is WDESC.
476 If WDESC is some other (smaller) window, we return 0. */
479 x_top_window_to_frame (dpyinfo
, wdesc
)
480 struct x_display_info
*dpyinfo
;
483 Lisp_Object tail
, frame
;
487 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
490 if (!GC_FRAMEP (frame
))
493 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
495 x
= f
->output_data
.x
;
499 /* This frame matches if the window is its topmost widget. */
500 if (wdesc
== XtWindow (x
->widget
))
502 #if 0 /* I don't know why it did this,
503 but it seems logically wrong,
504 and it causes trouble for MapNotify events. */
505 /* Match if the window is this frame's menubar. */
506 if (x
->menubar_widget
507 && wdesc
== XtWindow (x
->menubar_widget
))
511 else if (FRAME_X_WINDOW (f
) == wdesc
)
517 #endif /* USE_X_TOOLKIT */
521 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
522 id, which is just an int that this section returns. Bitmaps are
523 reference counted so they can be shared among frames.
525 Bitmap indices are guaranteed to be > 0, so a negative number can
526 be used to indicate no bitmap.
528 If you use x_create_bitmap_from_data, then you must keep track of
529 the bitmaps yourself. That is, creating a bitmap from the same
530 data more than once will not be caught. */
533 /* Functions to access the contents of a bitmap, given an id. */
536 x_bitmap_height (f
, id
)
540 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
544 x_bitmap_width (f
, id
)
548 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
552 x_bitmap_pixmap (f
, id
)
556 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
560 /* Allocate a new bitmap record. Returns index of new record. */
563 x_allocate_bitmap_record (f
)
566 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
569 if (dpyinfo
->bitmaps
== NULL
)
571 dpyinfo
->bitmaps_size
= 10;
573 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
574 dpyinfo
->bitmaps_last
= 1;
578 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
579 return ++dpyinfo
->bitmaps_last
;
581 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
582 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
585 dpyinfo
->bitmaps_size
*= 2;
587 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
588 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
589 return ++dpyinfo
->bitmaps_last
;
592 /* Add one reference to the reference count of the bitmap with id ID. */
595 x_reference_bitmap (f
, id
)
599 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
602 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
605 x_create_bitmap_from_data (f
, bits
, width
, height
)
608 unsigned int width
, height
;
610 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
614 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
615 bits
, width
, height
);
620 id
= x_allocate_bitmap_record (f
);
621 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
622 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
623 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
624 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
625 dpyinfo
->bitmaps
[id
- 1].height
= height
;
626 dpyinfo
->bitmaps
[id
- 1].width
= width
;
631 /* Create bitmap from file FILE for frame F. */
634 x_create_bitmap_from_file (f
, file
)
638 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
639 unsigned int width
, height
;
641 int xhot
, yhot
, result
, id
;
646 /* Look for an existing bitmap with the same name. */
647 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
649 if (dpyinfo
->bitmaps
[id
].refcount
650 && dpyinfo
->bitmaps
[id
].file
651 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
653 ++dpyinfo
->bitmaps
[id
].refcount
;
658 /* Search bitmap-file-path for the file, if appropriate. */
659 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
662 /* XReadBitmapFile won't handle magic file names. */
667 filename
= (char *) XSTRING (found
)->data
;
669 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
670 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
671 if (result
!= BitmapSuccess
)
674 id
= x_allocate_bitmap_record (f
);
675 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
676 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
677 dpyinfo
->bitmaps
[id
- 1].file
678 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
679 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
680 dpyinfo
->bitmaps
[id
- 1].height
= height
;
681 dpyinfo
->bitmaps
[id
- 1].width
= width
;
682 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
687 /* Remove reference to bitmap with id number ID. */
690 x_destroy_bitmap (f
, id
)
694 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
698 --dpyinfo
->bitmaps
[id
- 1].refcount
;
699 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
702 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
703 if (dpyinfo
->bitmaps
[id
- 1].file
)
705 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
706 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
713 /* Free all the bitmaps for the display specified by DPYINFO. */
716 x_destroy_all_bitmaps (dpyinfo
)
717 struct x_display_info
*dpyinfo
;
720 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
721 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
723 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
724 if (dpyinfo
->bitmaps
[i
].file
)
725 xfree (dpyinfo
->bitmaps
[i
].file
);
727 dpyinfo
->bitmaps_last
= 0;
730 /* Connect the frame-parameter names for X frames
731 to the ways of passing the parameter values to the window system.
733 The name of a parameter, as a Lisp symbol,
734 has an `x-frame-parameter' property which is an integer in Lisp
735 that is an index in this table. */
737 struct x_frame_parm_table
740 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
750 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
755 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
760 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
763 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
764 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
765 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
766 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
768 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
770 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
775 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
777 static struct x_frame_parm_table x_frame_parms
[] =
779 "auto-raise", x_set_autoraise
,
780 "auto-lower", x_set_autolower
,
781 "background-color", x_set_background_color
,
782 "border-color", x_set_border_color
,
783 "border-width", x_set_border_width
,
784 "cursor-color", x_set_cursor_color
,
785 "cursor-type", x_set_cursor_type
,
787 "foreground-color", x_set_foreground_color
,
788 "icon-name", x_set_icon_name
,
789 "icon-type", x_set_icon_type
,
790 "internal-border-width", x_set_internal_border_width
,
791 "menu-bar-lines", x_set_menu_bar_lines
,
792 "mouse-color", x_set_mouse_color
,
793 "name", x_explicitly_set_name
,
794 "scroll-bar-width", x_set_scroll_bar_width
,
795 "title", x_set_title
,
796 "unsplittable", x_set_unsplittable
,
797 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
798 "visibility", x_set_visibility
,
799 "tool-bar-lines", x_set_tool_bar_lines
,
800 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
801 "scroll-bar-background", x_set_scroll_bar_background
,
802 "screen-gamma", x_set_screen_gamma
805 /* Attach the `x-frame-parameter' properties to
806 the Lisp symbol names of parameters relevant to X. */
809 init_x_parm_symbols ()
813 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
814 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
818 /* Change the parameters of frame F as specified by ALIST.
819 If a parameter is not specially recognized, do nothing;
820 otherwise call the `x_set_...' function for that parameter. */
823 x_set_frame_parameters (f
, alist
)
829 /* If both of these parameters are present, it's more efficient to
830 set them both at once. So we wait until we've looked at the
831 entire list before we set them. */
835 Lisp_Object left
, top
;
837 /* Same with these. */
838 Lisp_Object icon_left
, icon_top
;
840 /* Record in these vectors all the parms specified. */
844 int left_no_change
= 0, top_no_change
= 0;
845 int icon_left_no_change
= 0, icon_top_no_change
= 0;
847 struct gcpro gcpro1
, gcpro2
;
850 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
853 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
854 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
856 /* Extract parm names and values into those vectors. */
859 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
864 parms
[i
] = Fcar (elt
);
865 values
[i
] = Fcdr (elt
);
868 /* TAIL and ALIST are not used again below here. */
871 GCPRO2 (*parms
, *values
);
875 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
876 because their values appear in VALUES and strings are not valid. */
877 top
= left
= Qunbound
;
878 icon_left
= icon_top
= Qunbound
;
880 /* Provide default values for HEIGHT and WIDTH. */
881 if (FRAME_NEW_WIDTH (f
))
882 width
= FRAME_NEW_WIDTH (f
);
884 width
= FRAME_WIDTH (f
);
886 if (FRAME_NEW_HEIGHT (f
))
887 height
= FRAME_NEW_HEIGHT (f
);
889 height
= FRAME_HEIGHT (f
);
891 /* Process foreground_color and background_color before anything else.
892 They are independent of other properties, but other properties (e.g.,
893 cursor_color) are dependent upon them. */
894 for (p
= 0; p
< i
; p
++)
896 Lisp_Object prop
, val
;
900 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
902 register Lisp_Object param_index
, old_value
;
904 param_index
= Fget (prop
, Qx_frame_parameter
);
905 old_value
= get_frame_param (f
, prop
);
906 store_frame_param (f
, prop
, val
);
907 if (NATNUMP (param_index
)
908 && (XFASTINT (param_index
)
909 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
910 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
914 /* Now process them in reverse of specified order. */
915 for (i
--; i
>= 0; i
--)
917 Lisp_Object prop
, val
;
922 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
923 width
= XFASTINT (val
);
924 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
925 height
= XFASTINT (val
);
926 else if (EQ (prop
, Qtop
))
928 else if (EQ (prop
, Qleft
))
930 else if (EQ (prop
, Qicon_top
))
932 else if (EQ (prop
, Qicon_left
))
934 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
935 /* Processed above. */
939 register Lisp_Object param_index
, old_value
;
941 param_index
= Fget (prop
, Qx_frame_parameter
);
942 old_value
= get_frame_param (f
, prop
);
943 store_frame_param (f
, prop
, val
);
944 if (NATNUMP (param_index
)
945 && (XFASTINT (param_index
)
946 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
947 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
951 /* Don't die if just one of these was set. */
952 if (EQ (left
, Qunbound
))
955 if (f
->output_data
.x
->left_pos
< 0)
956 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
958 XSETINT (left
, f
->output_data
.x
->left_pos
);
960 if (EQ (top
, Qunbound
))
963 if (f
->output_data
.x
->top_pos
< 0)
964 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
966 XSETINT (top
, f
->output_data
.x
->top_pos
);
969 /* If one of the icon positions was not set, preserve or default it. */
970 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
972 icon_left_no_change
= 1;
973 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
974 if (NILP (icon_left
))
975 XSETINT (icon_left
, 0);
977 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
979 icon_top_no_change
= 1;
980 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
982 XSETINT (icon_top
, 0);
985 /* Don't set these parameters unless they've been explicitly
986 specified. The window might be mapped or resized while we're in
987 this function, and we don't want to override that unless the lisp
988 code has asked for it.
990 Don't set these parameters unless they actually differ from the
991 window's current parameters; the window may not actually exist
996 check_frame_size (f
, &height
, &width
);
998 XSETFRAME (frame
, f
);
1000 if (width
!= FRAME_WIDTH (f
)
1001 || height
!= FRAME_HEIGHT (f
)
1002 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
1003 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1005 if ((!NILP (left
) || !NILP (top
))
1006 && ! (left_no_change
&& top_no_change
)
1007 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1008 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1013 /* Record the signs. */
1014 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1015 if (EQ (left
, Qminus
))
1016 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1017 else if (INTEGERP (left
))
1019 leftpos
= XINT (left
);
1021 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1023 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1024 && CONSP (XCDR (left
))
1025 && INTEGERP (XCAR (XCDR (left
))))
1027 leftpos
= - XINT (XCAR (XCDR (left
)));
1028 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1030 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1031 && CONSP (XCDR (left
))
1032 && INTEGERP (XCAR (XCDR (left
))))
1034 leftpos
= XINT (XCAR (XCDR (left
)));
1037 if (EQ (top
, Qminus
))
1038 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1039 else if (INTEGERP (top
))
1041 toppos
= XINT (top
);
1043 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1045 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1046 && CONSP (XCDR (top
))
1047 && INTEGERP (XCAR (XCDR (top
))))
1049 toppos
= - XINT (XCAR (XCDR (top
)));
1050 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1052 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1053 && CONSP (XCDR (top
))
1054 && INTEGERP (XCAR (XCDR (top
))))
1056 toppos
= XINT (XCAR (XCDR (top
)));
1060 /* Store the numeric value of the position. */
1061 f
->output_data
.x
->top_pos
= toppos
;
1062 f
->output_data
.x
->left_pos
= leftpos
;
1064 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1066 /* Actually set that position, and convert to absolute. */
1067 x_set_offset (f
, leftpos
, toppos
, -1);
1070 if ((!NILP (icon_left
) || !NILP (icon_top
))
1071 && ! (icon_left_no_change
&& icon_top_no_change
))
1072 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1078 /* Store the screen positions of frame F into XPTR and YPTR.
1079 These are the positions of the containing window manager window,
1080 not Emacs's own window. */
1083 x_real_positions (f
, xptr
, yptr
)
1090 /* This is pretty gross, but seems to be the easiest way out of
1091 the problem that arises when restarting window-managers. */
1093 #ifdef USE_X_TOOLKIT
1094 Window outer
= (f
->output_data
.x
->widget
1095 ? XtWindow (f
->output_data
.x
->widget
)
1096 : FRAME_X_WINDOW (f
));
1098 Window outer
= f
->output_data
.x
->window_desc
;
1100 Window tmp_root_window
;
1101 Window
*tmp_children
;
1106 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1107 Window outer_window
;
1109 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1110 &f
->output_data
.x
->parent_desc
,
1111 &tmp_children
, &tmp_nchildren
);
1112 XFree ((char *) tmp_children
);
1116 /* Find the position of the outside upper-left corner of
1117 the inner window, with respect to the outer window. */
1118 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1119 outer_window
= f
->output_data
.x
->parent_desc
;
1121 outer_window
= outer
;
1123 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1125 /* From-window, to-window. */
1127 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1129 /* From-position, to-position. */
1130 0, 0, &win_x
, &win_y
,
1135 /* It is possible for the window returned by the XQueryNotify
1136 to become invalid by the time we call XTranslateCoordinates.
1137 That can happen when you restart some window managers.
1138 If so, we get an error in XTranslateCoordinates.
1139 Detect that and try the whole thing over. */
1140 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1142 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1146 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1153 /* Insert a description of internally-recorded parameters of frame X
1154 into the parameter alist *ALISTPTR that is to be given to the user.
1155 Only parameters that are specific to the X window system
1156 and whose values are not correctly recorded in the frame's
1157 param_alist need to be considered here. */
1160 x_report_frame_params (f
, alistptr
)
1162 Lisp_Object
*alistptr
;
1167 /* Represent negative positions (off the top or left screen edge)
1168 in a way that Fmodify_frame_parameters will understand correctly. */
1169 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1170 if (f
->output_data
.x
->left_pos
>= 0)
1171 store_in_alist (alistptr
, Qleft
, tem
);
1173 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1175 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1176 if (f
->output_data
.x
->top_pos
>= 0)
1177 store_in_alist (alistptr
, Qtop
, tem
);
1179 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1181 store_in_alist (alistptr
, Qborder_width
,
1182 make_number (f
->output_data
.x
->border_width
));
1183 store_in_alist (alistptr
, Qinternal_border_width
,
1184 make_number (f
->output_data
.x
->internal_border_width
));
1185 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1186 store_in_alist (alistptr
, Qwindow_id
,
1187 build_string (buf
));
1188 #ifdef USE_X_TOOLKIT
1189 /* Tooltip frame may not have this widget. */
1190 if (f
->output_data
.x
->widget
)
1192 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1193 store_in_alist (alistptr
, Qouter_window_id
,
1194 build_string (buf
));
1195 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1196 FRAME_SAMPLE_VISIBILITY (f
);
1197 store_in_alist (alistptr
, Qvisibility
,
1198 (FRAME_VISIBLE_P (f
) ? Qt
1199 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1200 store_in_alist (alistptr
, Qdisplay
,
1201 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1203 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1206 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1207 store_in_alist (alistptr
, Qparent_id
, tem
);
1212 /* Gamma-correct COLOR on frame F. */
1215 gamma_correct (f
, color
)
1221 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1222 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1223 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1228 /* Decide if color named COLOR is valid for the display associated with
1229 the selected frame; if so, return the rgb values in COLOR_DEF.
1230 If ALLOC is nonzero, allocate a new colormap cell. */
1233 x_defined_color (f
, color
, color_def
, alloc
)
1239 register int status
;
1240 Colormap screen_colormap
;
1241 Display
*display
= FRAME_X_DISPLAY (f
);
1244 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1246 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1247 if (status
&& alloc
)
1249 /* Apply gamma correction. */
1250 gamma_correct (f
, color_def
);
1252 status
= XAllocColor (display
, screen_colormap
, color_def
);
1255 /* If we got to this point, the colormap is full, so we're
1256 going to try and get the next closest color.
1257 The algorithm used is a least-squares matching, which is
1258 what X uses for closest color matching with StaticColor visuals. */
1263 long nearest_delta
, trial_delta
;
1266 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1267 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1269 for (x
= 0; x
< no_cells
; x
++)
1272 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1274 /* I'm assuming CSE so I'm not going to condense this. */
1275 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1276 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1278 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1279 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1281 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1282 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1283 for (x
= 1; x
< no_cells
; x
++)
1285 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1286 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1288 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1289 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1291 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1292 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1293 if (trial_delta
< nearest_delta
)
1296 temp
.red
= cells
[x
].red
;
1297 temp
.green
= cells
[x
].green
;
1298 temp
.blue
= cells
[x
].blue
;
1299 status
= XAllocColor (display
, screen_colormap
, &temp
);
1303 nearest_delta
= trial_delta
;
1307 color_def
->red
= cells
[nearest
].red
;
1308 color_def
->green
= cells
[nearest
].green
;
1309 color_def
->blue
= cells
[nearest
].blue
;
1310 status
= XAllocColor (display
, screen_colormap
, color_def
);
1321 /* Given a string ARG naming a color, compute a pixel value from it
1322 suitable for screen F.
1323 If F is not a color screen, return DEF (default) regardless of what
1327 x_decode_color (f
, arg
, def
)
1334 CHECK_STRING (arg
, 0);
1336 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1337 return BLACK_PIX_DEFAULT (f
);
1338 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1339 return WHITE_PIX_DEFAULT (f
);
1341 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1344 /* x_defined_color is responsible for coping with failures
1345 by looking for a near-miss. */
1346 if (x_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1349 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1350 Fcons (arg
, Qnil
)));
1353 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1354 the previous value of that parameter, NEW_VALUE is the new value. */
1357 x_set_screen_gamma (f
, new_value
, old_value
)
1359 Lisp_Object new_value
, old_value
;
1361 if (NILP (new_value
))
1363 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1364 /* The value 0.4545 is the normal viewing gamma. */
1365 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1367 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1368 Fcons (new_value
, Qnil
)));
1370 clear_face_cache (0);
1374 /* Functions called only from `x_set_frame_param'
1375 to set individual parameters.
1377 If FRAME_X_WINDOW (f) is 0,
1378 the frame is being created and its X-window does not exist yet.
1379 In that case, just record the parameter's new value
1380 in the standard place; do not attempt to change the window. */
1383 x_set_foreground_color (f
, arg
, oldval
)
1385 Lisp_Object arg
, oldval
;
1388 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1390 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1391 f
->output_data
.x
->foreground_pixel
= pixel
;
1393 if (FRAME_X_WINDOW (f
) != 0)
1396 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1397 f
->output_data
.x
->foreground_pixel
);
1398 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1399 f
->output_data
.x
->foreground_pixel
);
1401 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1402 if (FRAME_VISIBLE_P (f
))
1408 x_set_background_color (f
, arg
, oldval
)
1410 Lisp_Object arg
, oldval
;
1413 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1415 unload_color (f
, f
->output_data
.x
->background_pixel
);
1416 f
->output_data
.x
->background_pixel
= pixel
;
1418 if (FRAME_X_WINDOW (f
) != 0)
1421 /* The main frame area. */
1422 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1423 f
->output_data
.x
->background_pixel
);
1424 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1425 f
->output_data
.x
->background_pixel
);
1426 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1427 f
->output_data
.x
->background_pixel
);
1428 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1429 f
->output_data
.x
->background_pixel
);
1432 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1433 bar
= XSCROLL_BAR (bar
)->next
)
1434 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1435 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1436 f
->output_data
.x
->background_pixel
);
1440 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1442 if (FRAME_VISIBLE_P (f
))
1448 x_set_mouse_color (f
, arg
, oldval
)
1450 Lisp_Object arg
, oldval
;
1452 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1455 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1456 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1458 /* Don't let pointers be invisible. */
1459 if (mask_color
== pixel
1460 && mask_color
== f
->output_data
.x
->background_pixel
)
1461 pixel
= f
->output_data
.x
->foreground_pixel
;
1463 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1464 f
->output_data
.x
->mouse_pixel
= pixel
;
1468 /* It's not okay to crash if the user selects a screwy cursor. */
1469 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1471 if (!EQ (Qnil
, Vx_pointer_shape
))
1473 CHECK_NUMBER (Vx_pointer_shape
, 0);
1474 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1477 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1478 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1480 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1482 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1483 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1484 XINT (Vx_nontext_pointer_shape
));
1487 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1488 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1490 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1492 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1493 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1494 XINT (Vx_busy_pointer_shape
));
1497 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1498 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1500 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1501 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1503 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1504 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1505 XINT (Vx_mode_pointer_shape
));
1508 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1509 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1511 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1513 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1515 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1516 XINT (Vx_sensitive_text_pointer_shape
));
1519 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1521 /* Check and report errors with the above calls. */
1522 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1523 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1526 XColor fore_color
, back_color
;
1528 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1529 back_color
.pixel
= mask_color
;
1530 XQueryColor (FRAME_X_DISPLAY (f
),
1531 DefaultColormap (FRAME_X_DISPLAY (f
),
1532 DefaultScreen (FRAME_X_DISPLAY (f
))),
1534 XQueryColor (FRAME_X_DISPLAY (f
),
1535 DefaultColormap (FRAME_X_DISPLAY (f
),
1536 DefaultScreen (FRAME_X_DISPLAY (f
))),
1538 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1539 &fore_color
, &back_color
);
1540 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1541 &fore_color
, &back_color
);
1542 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1543 &fore_color
, &back_color
);
1544 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1545 &fore_color
, &back_color
);
1546 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1547 &fore_color
, &back_color
);
1550 if (FRAME_X_WINDOW (f
) != 0)
1551 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1553 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1554 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1555 f
->output_data
.x
->text_cursor
= cursor
;
1557 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1558 && f
->output_data
.x
->nontext_cursor
!= 0)
1559 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1560 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1562 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1563 && f
->output_data
.x
->busy_cursor
!= 0)
1564 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1565 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1567 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1568 && f
->output_data
.x
->modeline_cursor
!= 0)
1569 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1570 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1572 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1573 && f
->output_data
.x
->cross_cursor
!= 0)
1574 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1575 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1577 XFlush (FRAME_X_DISPLAY (f
));
1580 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1584 x_set_cursor_color (f
, arg
, oldval
)
1586 Lisp_Object arg
, oldval
;
1588 unsigned long fore_pixel
, pixel
;
1590 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1591 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1592 WHITE_PIX_DEFAULT (f
));
1594 fore_pixel
= f
->output_data
.x
->background_pixel
;
1595 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1597 /* Make sure that the cursor color differs from the background color. */
1598 if (pixel
== f
->output_data
.x
->background_pixel
)
1600 pixel
= f
->output_data
.x
->mouse_pixel
;
1601 if (pixel
== fore_pixel
)
1602 fore_pixel
= f
->output_data
.x
->background_pixel
;
1605 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1606 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1608 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1609 f
->output_data
.x
->cursor_pixel
= pixel
;
1611 if (FRAME_X_WINDOW (f
) != 0)
1614 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1615 f
->output_data
.x
->cursor_pixel
);
1616 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1620 if (FRAME_VISIBLE_P (f
))
1622 x_update_cursor (f
, 0);
1623 x_update_cursor (f
, 1);
1627 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1630 /* Set the border-color of frame F to value described by ARG.
1631 ARG can be a string naming a color.
1632 The border-color is used for the border that is drawn by the X server.
1633 Note that this does not fully take effect if done before
1634 F has an x-window; it must be redone when the window is created.
1636 Note: this is done in two routines because of the way X10 works.
1638 Note: under X11, this is normally the province of the window manager,
1639 and so emacs' border colors may be overridden. */
1642 x_set_border_color (f
, arg
, oldval
)
1644 Lisp_Object arg
, oldval
;
1648 CHECK_STRING (arg
, 0);
1649 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1650 x_set_border_pixel (f
, pix
);
1651 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1654 /* Set the border-color of frame F to pixel value PIX.
1655 Note that this does not fully take effect if done before
1656 F has an x-window. */
1659 x_set_border_pixel (f
, pix
)
1663 unload_color (f
, f
->output_data
.x
->border_pixel
);
1664 f
->output_data
.x
->border_pixel
= pix
;
1666 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1669 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1670 (unsigned long)pix
);
1673 if (FRAME_VISIBLE_P (f
))
1679 x_set_cursor_type (f
, arg
, oldval
)
1681 Lisp_Object arg
, oldval
;
1685 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1686 f
->output_data
.x
->cursor_width
= 2;
1688 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1689 && INTEGERP (XCDR (arg
)))
1691 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1692 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1695 /* Treat anything unknown as "box cursor".
1696 It was bad to signal an error; people have trouble fixing
1697 .Xdefaults with Emacs, when it has something bad in it. */
1698 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1700 /* Make sure the cursor gets redrawn. This is overkill, but how
1701 often do people change cursor types? */
1702 update_mode_lines
++;
1706 x_set_icon_type (f
, arg
, oldval
)
1708 Lisp_Object arg
, oldval
;
1714 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1717 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1722 result
= x_text_icon (f
,
1723 (char *) XSTRING ((!NILP (f
->icon_name
)
1727 result
= x_bitmap_icon (f
, arg
);
1732 error ("No icon window available");
1735 XFlush (FRAME_X_DISPLAY (f
));
1739 /* Return non-nil if frame F wants a bitmap icon. */
1747 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1755 x_set_icon_name (f
, arg
, oldval
)
1757 Lisp_Object arg
, oldval
;
1763 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1766 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1771 if (f
->output_data
.x
->icon_bitmap
!= 0)
1776 result
= x_text_icon (f
,
1777 (char *) XSTRING ((!NILP (f
->icon_name
)
1786 error ("No icon window available");
1789 XFlush (FRAME_X_DISPLAY (f
));
1794 x_set_font (f
, arg
, oldval
)
1796 Lisp_Object arg
, oldval
;
1799 Lisp_Object fontset_name
;
1802 CHECK_STRING (arg
, 1);
1804 fontset_name
= Fquery_fontset (arg
, Qnil
);
1807 result
= (STRINGP (fontset_name
)
1808 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1809 : x_new_font (f
, XSTRING (arg
)->data
));
1812 if (EQ (result
, Qnil
))
1813 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1814 else if (EQ (result
, Qt
))
1815 error ("The characters of the given font have varying widths");
1816 else if (STRINGP (result
))
1818 store_frame_param (f
, Qfont
, result
);
1819 recompute_basic_faces (f
);
1824 do_pending_window_change (0);
1826 /* Don't call `face-set-after-frame-default' when faces haven't been
1827 initialized yet. This is the case when called from
1828 Fx_create_frame. In that case, the X widget or window doesn't
1829 exist either, and we can end up in x_report_frame_params with a
1830 null widget which gives a segfault. */
1831 if (FRAME_FACE_CACHE (f
))
1833 XSETFRAME (frame
, f
);
1834 call1 (Qface_set_after_frame_default
, frame
);
1839 x_set_border_width (f
, arg
, oldval
)
1841 Lisp_Object arg
, oldval
;
1843 CHECK_NUMBER (arg
, 0);
1845 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1848 if (FRAME_X_WINDOW (f
) != 0)
1849 error ("Cannot change the border width of a window");
1851 f
->output_data
.x
->border_width
= XINT (arg
);
1855 x_set_internal_border_width (f
, arg
, oldval
)
1857 Lisp_Object arg
, oldval
;
1859 int old
= f
->output_data
.x
->internal_border_width
;
1861 CHECK_NUMBER (arg
, 0);
1862 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1863 if (f
->output_data
.x
->internal_border_width
< 0)
1864 f
->output_data
.x
->internal_border_width
= 0;
1866 #ifdef USE_X_TOOLKIT
1867 if (f
->output_data
.x
->edit_widget
)
1868 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1871 if (f
->output_data
.x
->internal_border_width
== old
)
1874 if (FRAME_X_WINDOW (f
) != 0)
1876 x_set_window_size (f
, 0, f
->width
, f
->height
);
1877 SET_FRAME_GARBAGED (f
);
1878 do_pending_window_change (0);
1883 x_set_visibility (f
, value
, oldval
)
1885 Lisp_Object value
, oldval
;
1888 XSETFRAME (frame
, f
);
1891 Fmake_frame_invisible (frame
, Qt
);
1892 else if (EQ (value
, Qicon
))
1893 Ficonify_frame (frame
);
1895 Fmake_frame_visible (frame
);
1899 x_set_menu_bar_lines_1 (window
, n
)
1903 struct window
*w
= XWINDOW (window
);
1905 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1906 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1908 /* Handle just the top child in a vertical split. */
1909 if (!NILP (w
->vchild
))
1910 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1912 /* Adjust all children in a horizontal split. */
1913 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1915 w
= XWINDOW (window
);
1916 x_set_menu_bar_lines_1 (window
, n
);
1921 x_set_menu_bar_lines (f
, value
, oldval
)
1923 Lisp_Object value
, oldval
;
1926 #ifndef USE_X_TOOLKIT
1927 int olines
= FRAME_MENU_BAR_LINES (f
);
1930 /* Right now, menu bars don't work properly in minibuf-only frames;
1931 most of the commands try to apply themselves to the minibuffer
1932 frame itself, and get an error because you can't switch buffers
1933 in or split the minibuffer window. */
1934 if (FRAME_MINIBUF_ONLY_P (f
))
1937 if (INTEGERP (value
))
1938 nlines
= XINT (value
);
1942 /* Make sure we redisplay all windows in this frame. */
1943 windows_or_buffers_changed
++;
1945 #ifdef USE_X_TOOLKIT
1946 FRAME_MENU_BAR_LINES (f
) = 0;
1949 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1950 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1951 /* Make sure next redisplay shows the menu bar. */
1952 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1956 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1957 free_frame_menubar (f
);
1958 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1960 f
->output_data
.x
->menubar_widget
= 0;
1962 #else /* not USE_X_TOOLKIT */
1963 FRAME_MENU_BAR_LINES (f
) = nlines
;
1964 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1965 #endif /* not USE_X_TOOLKIT */
1970 /* Set the number of lines used for the tool bar of frame F to VALUE.
1971 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1972 is the old number of tool bar lines. This function changes the
1973 height of all windows on frame F to match the new tool bar height.
1974 The frame's height doesn't change. */
1977 x_set_tool_bar_lines (f
, value
, oldval
)
1979 Lisp_Object value
, oldval
;
1983 /* Use VALUE only if an integer >= 0. */
1984 if (INTEGERP (value
) && XINT (value
) >= 0)
1985 nlines
= XFASTINT (value
);
1989 /* Make sure we redisplay all windows in this frame. */
1990 ++windows_or_buffers_changed
;
1992 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1993 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1994 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
1999 /* Set the foreground color for scroll bars on frame F to VALUE.
2000 VALUE should be a string, a color name. If it isn't a string or
2001 isn't a valid color name, do nothing. OLDVAL is the old value of
2002 the frame parameter. */
2005 x_set_scroll_bar_foreground (f
, value
, oldval
)
2007 Lisp_Object value
, oldval
;
2009 unsigned long pixel
;
2011 if (STRINGP (value
))
2012 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2016 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2017 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2019 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2020 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2022 /* Remove all scroll bars because they have wrong colors. */
2023 if (condemn_scroll_bars_hook
)
2024 (*condemn_scroll_bars_hook
) (f
);
2025 if (judge_scroll_bars_hook
)
2026 (*judge_scroll_bars_hook
) (f
);
2028 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2034 /* Set the background color for scroll bars on frame F to VALUE VALUE
2035 should be a string, a color name. If it isn't a string or isn't a
2036 valid color name, do nothing. OLDVAL is the old value of the frame
2040 x_set_scroll_bar_background (f
, value
, oldval
)
2042 Lisp_Object value
, oldval
;
2044 unsigned long pixel
;
2046 if (STRINGP (value
))
2047 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2051 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2052 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2054 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2055 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2057 /* Remove all scroll bars because they have wrong colors. */
2058 if (condemn_scroll_bars_hook
)
2059 (*condemn_scroll_bars_hook
) (f
);
2060 if (judge_scroll_bars_hook
)
2061 (*judge_scroll_bars_hook
) (f
);
2063 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2069 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2072 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2073 name; if NAME is a string, set F's name to NAME and set
2074 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2076 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2077 suggesting a new name, which lisp code should override; if
2078 F->explicit_name is set, ignore the new name; otherwise, set it. */
2081 x_set_name (f
, name
, explicit)
2086 /* Make sure that requests from lisp code override requests from
2087 Emacs redisplay code. */
2090 /* If we're switching from explicit to implicit, we had better
2091 update the mode lines and thereby update the title. */
2092 if (f
->explicit_name
&& NILP (name
))
2093 update_mode_lines
= 1;
2095 f
->explicit_name
= ! NILP (name
);
2097 else if (f
->explicit_name
)
2100 /* If NAME is nil, set the name to the x_id_name. */
2103 /* Check for no change needed in this very common case
2104 before we do any consing. */
2105 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2106 XSTRING (f
->name
)->data
))
2108 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2111 CHECK_STRING (name
, 0);
2113 /* Don't change the name if it's already NAME. */
2114 if (! NILP (Fstring_equal (name
, f
->name
)))
2119 /* For setting the frame title, the title parameter should override
2120 the name parameter. */
2121 if (! NILP (f
->title
))
2124 if (FRAME_X_WINDOW (f
))
2129 XTextProperty text
, icon
;
2130 Lisp_Object icon_name
;
2132 text
.value
= XSTRING (name
)->data
;
2133 text
.encoding
= XA_STRING
;
2135 text
.nitems
= STRING_BYTES (XSTRING (name
));
2137 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2139 icon
.value
= XSTRING (icon_name
)->data
;
2140 icon
.encoding
= XA_STRING
;
2142 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2143 #ifdef USE_X_TOOLKIT
2144 XSetWMName (FRAME_X_DISPLAY (f
),
2145 XtWindow (f
->output_data
.x
->widget
), &text
);
2146 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2148 #else /* not USE_X_TOOLKIT */
2149 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2150 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2151 #endif /* not USE_X_TOOLKIT */
2153 #else /* not HAVE_X11R4 */
2154 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2155 XSTRING (name
)->data
);
2156 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2157 XSTRING (name
)->data
);
2158 #endif /* not HAVE_X11R4 */
2163 /* This function should be called when the user's lisp code has
2164 specified a name for the frame; the name will override any set by the
2167 x_explicitly_set_name (f
, arg
, oldval
)
2169 Lisp_Object arg
, oldval
;
2171 x_set_name (f
, arg
, 1);
2174 /* This function should be called by Emacs redisplay code to set the
2175 name; names set this way will never override names set by the user's
2178 x_implicitly_set_name (f
, arg
, oldval
)
2180 Lisp_Object arg
, oldval
;
2182 x_set_name (f
, arg
, 0);
2185 /* Change the title of frame F to NAME.
2186 If NAME is nil, use the frame name as the title.
2188 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2189 name; if NAME is a string, set F's name to NAME and set
2190 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2192 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2193 suggesting a new name, which lisp code should override; if
2194 F->explicit_name is set, ignore the new name; otherwise, set it. */
2197 x_set_title (f
, name
, old_name
)
2199 Lisp_Object name
, old_name
;
2201 /* Don't change the title if it's already NAME. */
2202 if (EQ (name
, f
->title
))
2205 update_mode_lines
= 1;
2212 CHECK_STRING (name
, 0);
2214 if (FRAME_X_WINDOW (f
))
2219 XTextProperty text
, icon
;
2220 Lisp_Object icon_name
;
2222 text
.value
= XSTRING (name
)->data
;
2223 text
.encoding
= XA_STRING
;
2225 text
.nitems
= STRING_BYTES (XSTRING (name
));
2227 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2229 icon
.value
= XSTRING (icon_name
)->data
;
2230 icon
.encoding
= XA_STRING
;
2232 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2233 #ifdef USE_X_TOOLKIT
2234 XSetWMName (FRAME_X_DISPLAY (f
),
2235 XtWindow (f
->output_data
.x
->widget
), &text
);
2236 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2238 #else /* not USE_X_TOOLKIT */
2239 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2240 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2241 #endif /* not USE_X_TOOLKIT */
2243 #else /* not HAVE_X11R4 */
2244 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2245 XSTRING (name
)->data
);
2246 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2247 XSTRING (name
)->data
);
2248 #endif /* not HAVE_X11R4 */
2254 x_set_autoraise (f
, arg
, oldval
)
2256 Lisp_Object arg
, oldval
;
2258 f
->auto_raise
= !EQ (Qnil
, arg
);
2262 x_set_autolower (f
, arg
, oldval
)
2264 Lisp_Object arg
, oldval
;
2266 f
->auto_lower
= !EQ (Qnil
, arg
);
2270 x_set_unsplittable (f
, arg
, oldval
)
2272 Lisp_Object arg
, oldval
;
2274 f
->no_split
= !NILP (arg
);
2278 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2280 Lisp_Object arg
, oldval
;
2282 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2283 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2284 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2285 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2287 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2289 ? vertical_scroll_bar_none
2291 ? vertical_scroll_bar_right
2292 : vertical_scroll_bar_left
);
2294 /* We set this parameter before creating the X window for the
2295 frame, so we can get the geometry right from the start.
2296 However, if the window hasn't been created yet, we shouldn't
2297 call x_set_window_size. */
2298 if (FRAME_X_WINDOW (f
))
2299 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2300 do_pending_window_change (0);
2305 x_set_scroll_bar_width (f
, arg
, oldval
)
2307 Lisp_Object arg
, oldval
;
2309 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2313 #ifdef USE_TOOLKIT_SCROLL_BARS
2314 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2315 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2316 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2317 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2319 /* Make the actual width at least 14 pixels and a multiple of a
2321 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2323 /* Use all of that space (aside from required margins) for the
2325 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2328 if (FRAME_X_WINDOW (f
))
2329 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2330 do_pending_window_change (0);
2332 else if (INTEGERP (arg
) && XINT (arg
) > 0
2333 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2335 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2336 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2338 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2339 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2340 if (FRAME_X_WINDOW (f
))
2341 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2344 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2345 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2346 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2351 /* Subroutines of creating an X frame. */
2353 /* Make sure that Vx_resource_name is set to a reasonable value.
2354 Fix it up, or set it to `emacs' if it is too hopeless. */
2357 validate_x_resource_name ()
2360 /* Number of valid characters in the resource name. */
2362 /* Number of invalid characters in the resource name. */
2367 if (!STRINGP (Vx_resource_class
))
2368 Vx_resource_class
= build_string (EMACS_CLASS
);
2370 if (STRINGP (Vx_resource_name
))
2372 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2375 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2377 /* Only letters, digits, - and _ are valid in resource names.
2378 Count the valid characters and count the invalid ones. */
2379 for (i
= 0; i
< len
; i
++)
2382 if (! ((c
>= 'a' && c
<= 'z')
2383 || (c
>= 'A' && c
<= 'Z')
2384 || (c
>= '0' && c
<= '9')
2385 || c
== '-' || c
== '_'))
2392 /* Not a string => completely invalid. */
2393 bad_count
= 5, good_count
= 0;
2395 /* If name is valid already, return. */
2399 /* If name is entirely invalid, or nearly so, use `emacs'. */
2401 || (good_count
== 1 && bad_count
> 0))
2403 Vx_resource_name
= build_string ("emacs");
2407 /* Name is partly valid. Copy it and replace the invalid characters
2408 with underscores. */
2410 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2412 for (i
= 0; i
< len
; i
++)
2414 int c
= XSTRING (new)->data
[i
];
2415 if (! ((c
>= 'a' && c
<= 'z')
2416 || (c
>= 'A' && c
<= 'Z')
2417 || (c
>= '0' && c
<= '9')
2418 || c
== '-' || c
== '_'))
2419 XSTRING (new)->data
[i
] = '_';
2424 extern char *x_get_string_resource ();
2426 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2427 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2428 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2429 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2430 the name specified by the `-name' or `-rn' command-line arguments.\n\
2432 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2433 class, respectively. You must specify both of them or neither.\n\
2434 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2435 and the class is `Emacs.CLASS.SUBCLASS'.")
2436 (attribute
, class, component
, subclass
)
2437 Lisp_Object attribute
, class, component
, subclass
;
2439 register char *value
;
2445 CHECK_STRING (attribute
, 0);
2446 CHECK_STRING (class, 0);
2448 if (!NILP (component
))
2449 CHECK_STRING (component
, 1);
2450 if (!NILP (subclass
))
2451 CHECK_STRING (subclass
, 2);
2452 if (NILP (component
) != NILP (subclass
))
2453 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2455 validate_x_resource_name ();
2457 /* Allocate space for the components, the dots which separate them,
2458 and the final '\0'. Make them big enough for the worst case. */
2459 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2460 + (STRINGP (component
)
2461 ? STRING_BYTES (XSTRING (component
)) : 0)
2462 + STRING_BYTES (XSTRING (attribute
))
2465 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2466 + STRING_BYTES (XSTRING (class))
2467 + (STRINGP (subclass
)
2468 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2471 /* Start with emacs.FRAMENAME for the name (the specific one)
2472 and with `Emacs' for the class key (the general one). */
2473 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2474 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2476 strcat (class_key
, ".");
2477 strcat (class_key
, XSTRING (class)->data
);
2479 if (!NILP (component
))
2481 strcat (class_key
, ".");
2482 strcat (class_key
, XSTRING (subclass
)->data
);
2484 strcat (name_key
, ".");
2485 strcat (name_key
, XSTRING (component
)->data
);
2488 strcat (name_key
, ".");
2489 strcat (name_key
, XSTRING (attribute
)->data
);
2491 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2492 name_key
, class_key
);
2494 if (value
!= (char *) 0)
2495 return build_string (value
);
2500 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2503 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2504 struct x_display_info
*dpyinfo
;
2505 Lisp_Object attribute
, class, component
, subclass
;
2507 register char *value
;
2513 CHECK_STRING (attribute
, 0);
2514 CHECK_STRING (class, 0);
2516 if (!NILP (component
))
2517 CHECK_STRING (component
, 1);
2518 if (!NILP (subclass
))
2519 CHECK_STRING (subclass
, 2);
2520 if (NILP (component
) != NILP (subclass
))
2521 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2523 validate_x_resource_name ();
2525 /* Allocate space for the components, the dots which separate them,
2526 and the final '\0'. Make them big enough for the worst case. */
2527 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2528 + (STRINGP (component
)
2529 ? STRING_BYTES (XSTRING (component
)) : 0)
2530 + STRING_BYTES (XSTRING (attribute
))
2533 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2534 + STRING_BYTES (XSTRING (class))
2535 + (STRINGP (subclass
)
2536 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2539 /* Start with emacs.FRAMENAME for the name (the specific one)
2540 and with `Emacs' for the class key (the general one). */
2541 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2542 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2544 strcat (class_key
, ".");
2545 strcat (class_key
, XSTRING (class)->data
);
2547 if (!NILP (component
))
2549 strcat (class_key
, ".");
2550 strcat (class_key
, XSTRING (subclass
)->data
);
2552 strcat (name_key
, ".");
2553 strcat (name_key
, XSTRING (component
)->data
);
2556 strcat (name_key
, ".");
2557 strcat (name_key
, XSTRING (attribute
)->data
);
2559 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2561 if (value
!= (char *) 0)
2562 return build_string (value
);
2567 /* Used when C code wants a resource value. */
2570 x_get_resource_string (attribute
, class)
2571 char *attribute
, *class;
2575 struct frame
*sf
= SELECTED_FRAME ();
2577 /* Allocate space for the components, the dots which separate them,
2578 and the final '\0'. */
2579 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2580 + strlen (attribute
) + 2);
2581 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2582 + strlen (class) + 2);
2584 sprintf (name_key
, "%s.%s",
2585 XSTRING (Vinvocation_name
)->data
,
2587 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2589 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2590 name_key
, class_key
);
2593 /* Types we might convert a resource string into. */
2603 /* Return the value of parameter PARAM.
2605 First search ALIST, then Vdefault_frame_alist, then the X defaults
2606 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2608 Convert the resource to the type specified by desired_type.
2610 If no default is specified, return Qunbound. If you call
2611 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2612 and don't let it get stored in any Lisp-visible variables! */
2615 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2616 struct x_display_info
*dpyinfo
;
2617 Lisp_Object alist
, param
;
2620 enum resource_types type
;
2622 register Lisp_Object tem
;
2624 tem
= Fassq (param
, alist
);
2626 tem
= Fassq (param
, Vdefault_frame_alist
);
2632 tem
= display_x_get_resource (dpyinfo
,
2633 build_string (attribute
),
2634 build_string (class),
2642 case RES_TYPE_NUMBER
:
2643 return make_number (atoi (XSTRING (tem
)->data
));
2645 case RES_TYPE_FLOAT
:
2646 return make_float (atof (XSTRING (tem
)->data
));
2648 case RES_TYPE_BOOLEAN
:
2649 tem
= Fdowncase (tem
);
2650 if (!strcmp (XSTRING (tem
)->data
, "on")
2651 || !strcmp (XSTRING (tem
)->data
, "true"))
2656 case RES_TYPE_STRING
:
2659 case RES_TYPE_SYMBOL
:
2660 /* As a special case, we map the values `true' and `on'
2661 to Qt, and `false' and `off' to Qnil. */
2664 lower
= Fdowncase (tem
);
2665 if (!strcmp (XSTRING (lower
)->data
, "on")
2666 || !strcmp (XSTRING (lower
)->data
, "true"))
2668 else if (!strcmp (XSTRING (lower
)->data
, "off")
2669 || !strcmp (XSTRING (lower
)->data
, "false"))
2672 return Fintern (tem
, Qnil
);
2685 /* Like x_get_arg, but also record the value in f->param_alist. */
2688 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2690 Lisp_Object alist
, param
;
2693 enum resource_types type
;
2697 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2698 attribute
, class, type
);
2700 store_frame_param (f
, param
, value
);
2705 /* Record in frame F the specified or default value according to ALIST
2706 of the parameter named PROP (a Lisp symbol).
2707 If no value is specified for PROP, look for an X default for XPROP
2708 on the frame named NAME.
2709 If that is not found either, use the value DEFLT. */
2712 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2719 enum resource_types type
;
2723 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2724 if (EQ (tem
, Qunbound
))
2726 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2731 /* Record in frame F the specified or default value according to ALIST
2732 of the parameter named PROP (a Lisp symbol). If no value is
2733 specified for PROP, look for an X default for XPROP on the frame
2734 named NAME. If that is not found either, use the value DEFLT. */
2737 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2746 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2749 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2750 if (EQ (tem
, Qunbound
))
2752 #ifdef USE_TOOLKIT_SCROLL_BARS
2754 /* See if an X resource for the scroll bar color has been
2756 tem
= display_x_get_resource (dpyinfo
,
2757 build_string (foreground_p
2761 build_string ("verticalScrollBar"),
2765 /* If nothing has been specified, scroll bars will use a
2766 toolkit-dependent default. Because these defaults are
2767 difficult to get at without actually creating a scroll
2768 bar, use nil to indicate that no color has been
2773 #else /* not USE_TOOLKIT_SCROLL_BARS */
2777 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2780 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2786 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2787 "Parse an X-style geometry string STRING.\n\
2788 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2789 The properties returned may include `top', `left', `height', and `width'.\n\
2790 The value of `left' or `top' may be an integer,\n\
2791 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2792 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2797 unsigned int width
, height
;
2800 CHECK_STRING (string
, 0);
2802 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2803 &x
, &y
, &width
, &height
);
2806 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2807 error ("Must specify both x and y position, or neither");
2811 if (geometry
& XValue
)
2813 Lisp_Object element
;
2815 if (x
>= 0 && (geometry
& XNegative
))
2816 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2817 else if (x
< 0 && ! (geometry
& XNegative
))
2818 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2820 element
= Fcons (Qleft
, make_number (x
));
2821 result
= Fcons (element
, result
);
2824 if (geometry
& YValue
)
2826 Lisp_Object element
;
2828 if (y
>= 0 && (geometry
& YNegative
))
2829 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2830 else if (y
< 0 && ! (geometry
& YNegative
))
2831 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2833 element
= Fcons (Qtop
, make_number (y
));
2834 result
= Fcons (element
, result
);
2837 if (geometry
& WidthValue
)
2838 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2839 if (geometry
& HeightValue
)
2840 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2845 /* Calculate the desired size and position of this window,
2846 and return the flags saying which aspects were specified.
2848 This function does not make the coordinates positive. */
2850 #define DEFAULT_ROWS 40
2851 #define DEFAULT_COLS 80
2854 x_figure_window_size (f
, parms
)
2858 register Lisp_Object tem0
, tem1
, tem2
;
2859 long window_prompting
= 0;
2860 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2862 /* Default values if we fall through.
2863 Actually, if that happens we should get
2864 window manager prompting. */
2865 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2866 f
->height
= DEFAULT_ROWS
;
2867 /* Window managers expect that if program-specified
2868 positions are not (0,0), they're intentional, not defaults. */
2869 f
->output_data
.x
->top_pos
= 0;
2870 f
->output_data
.x
->left_pos
= 0;
2872 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2873 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2874 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2875 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2877 if (!EQ (tem0
, Qunbound
))
2879 CHECK_NUMBER (tem0
, 0);
2880 f
->height
= XINT (tem0
);
2882 if (!EQ (tem1
, Qunbound
))
2884 CHECK_NUMBER (tem1
, 0);
2885 SET_FRAME_WIDTH (f
, XINT (tem1
));
2887 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2888 window_prompting
|= USSize
;
2890 window_prompting
|= PSize
;
2893 f
->output_data
.x
->vertical_scroll_bar_extra
2894 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2896 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2897 f
->output_data
.x
->flags_areas_extra
2898 = FRAME_FLAGS_AREA_WIDTH (f
);
2899 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2900 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2902 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2903 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2904 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2905 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2907 if (EQ (tem0
, Qminus
))
2909 f
->output_data
.x
->top_pos
= 0;
2910 window_prompting
|= YNegative
;
2912 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2913 && CONSP (XCDR (tem0
))
2914 && INTEGERP (XCAR (XCDR (tem0
))))
2916 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2917 window_prompting
|= YNegative
;
2919 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2920 && CONSP (XCDR (tem0
))
2921 && INTEGERP (XCAR (XCDR (tem0
))))
2923 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2925 else if (EQ (tem0
, Qunbound
))
2926 f
->output_data
.x
->top_pos
= 0;
2929 CHECK_NUMBER (tem0
, 0);
2930 f
->output_data
.x
->top_pos
= XINT (tem0
);
2931 if (f
->output_data
.x
->top_pos
< 0)
2932 window_prompting
|= YNegative
;
2935 if (EQ (tem1
, Qminus
))
2937 f
->output_data
.x
->left_pos
= 0;
2938 window_prompting
|= XNegative
;
2940 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2941 && CONSP (XCDR (tem1
))
2942 && INTEGERP (XCAR (XCDR (tem1
))))
2944 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2945 window_prompting
|= XNegative
;
2947 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2948 && CONSP (XCDR (tem1
))
2949 && INTEGERP (XCAR (XCDR (tem1
))))
2951 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2953 else if (EQ (tem1
, Qunbound
))
2954 f
->output_data
.x
->left_pos
= 0;
2957 CHECK_NUMBER (tem1
, 0);
2958 f
->output_data
.x
->left_pos
= XINT (tem1
);
2959 if (f
->output_data
.x
->left_pos
< 0)
2960 window_prompting
|= XNegative
;
2963 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2964 window_prompting
|= USPosition
;
2966 window_prompting
|= PPosition
;
2969 return window_prompting
;
2972 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2975 XSetWMProtocols (dpy
, w
, protocols
, count
)
2982 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2983 if (prop
== None
) return False
;
2984 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2985 (unsigned char *) protocols
, count
);
2988 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2990 #ifdef USE_X_TOOLKIT
2992 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2993 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2994 already be present because of the toolkit (Motif adds some of them,
2995 for example, but Xt doesn't). */
2998 hack_wm_protocols (f
, widget
)
3002 Display
*dpy
= XtDisplay (widget
);
3003 Window w
= XtWindow (widget
);
3004 int need_delete
= 1;
3010 Atom type
, *atoms
= 0;
3012 unsigned long nitems
= 0;
3013 unsigned long bytes_after
;
3015 if ((XGetWindowProperty (dpy
, w
,
3016 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3017 (long)0, (long)100, False
, XA_ATOM
,
3018 &type
, &format
, &nitems
, &bytes_after
,
3019 (unsigned char **) &atoms
)
3021 && format
== 32 && type
== XA_ATOM
)
3025 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3027 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3029 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3032 if (atoms
) XFree ((char *) atoms
);
3038 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3040 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3042 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3044 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3045 XA_ATOM
, 32, PropModeAppend
,
3046 (unsigned char *) props
, count
);
3052 #ifdef USE_X_TOOLKIT
3054 /* Create and set up the X widget for frame F. */
3057 x_window (f
, window_prompting
, minibuffer_only
)
3059 long window_prompting
;
3060 int minibuffer_only
;
3062 XClassHint class_hints
;
3063 XSetWindowAttributes attributes
;
3064 unsigned long attribute_mask
;
3066 Widget shell_widget
;
3068 Widget frame_widget
;
3074 /* Use the resource name as the top-level widget name
3075 for looking up resources. Make a non-Lisp copy
3076 for the window manager, so GC relocation won't bother it.
3078 Elsewhere we specify the window name for the window manager. */
3081 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3082 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3083 strcpy (f
->namebuf
, str
);
3087 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3088 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3089 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3090 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3091 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3092 applicationShellWidgetClass
,
3093 FRAME_X_DISPLAY (f
), al
, ac
);
3095 f
->output_data
.x
->widget
= shell_widget
;
3096 /* maybe_set_screen_title_format (shell_widget); */
3098 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3099 (widget_value
*) NULL
,
3100 shell_widget
, False
,
3103 (lw_callback
) NULL
);
3105 f
->output_data
.x
->column_widget
= pane_widget
;
3107 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3108 the emacs screen when changing menubar. This reduces flickering. */
3111 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3112 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3113 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3114 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3115 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3116 frame_widget
= XtCreateWidget (f
->namebuf
,
3118 pane_widget
, al
, ac
);
3120 f
->output_data
.x
->edit_widget
= frame_widget
;
3122 XtManageChild (frame_widget
);
3124 /* Do some needed geometry management. */
3127 char *tem
, shell_position
[32];
3130 int extra_borders
= 0;
3132 = (f
->output_data
.x
->menubar_widget
3133 ? (f
->output_data
.x
->menubar_widget
->core
.height
3134 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3137 #if 0 /* Experimentally, we now get the right results
3138 for -geometry -0-0 without this. 24 Aug 96, rms. */
3139 if (FRAME_EXTERNAL_MENU_BAR (f
))
3142 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3143 menubar_size
+= ibw
;
3147 f
->output_data
.x
->menubar_height
= menubar_size
;
3150 /* Motif seems to need this amount added to the sizes
3151 specified for the shell widget. The Athena/Lucid widgets don't.
3152 Both conclusions reached experimentally. -- rms. */
3153 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3154 &extra_borders
, NULL
);
3158 /* Convert our geometry parameters into a geometry string
3160 Note that we do not specify here whether the position
3161 is a user-specified or program-specified one.
3162 We pass that information later, in x_wm_set_size_hints. */
3164 int left
= f
->output_data
.x
->left_pos
;
3165 int xneg
= window_prompting
& XNegative
;
3166 int top
= f
->output_data
.x
->top_pos
;
3167 int yneg
= window_prompting
& YNegative
;
3173 if (window_prompting
& USPosition
)
3174 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3175 PIXEL_WIDTH (f
) + extra_borders
,
3176 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3177 (xneg
? '-' : '+'), left
,
3178 (yneg
? '-' : '+'), top
);
3180 sprintf (shell_position
, "=%dx%d",
3181 PIXEL_WIDTH (f
) + extra_borders
,
3182 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3185 len
= strlen (shell_position
) + 1;
3186 /* We don't free this because we don't know whether
3187 it is safe to free it while the frame exists.
3188 It isn't worth the trouble of arranging to free it
3189 when the frame is deleted. */
3190 tem
= (char *) xmalloc (len
);
3191 strncpy (tem
, shell_position
, len
);
3192 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3193 XtSetValues (shell_widget
, al
, ac
);
3196 XtManageChild (pane_widget
);
3197 XtRealizeWidget (shell_widget
);
3199 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3201 validate_x_resource_name ();
3203 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3204 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3205 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3208 #ifndef X_I18N_INHIBITED
3213 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
3217 xic
= XCreateIC (xim
,
3218 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3219 XNClientWindow
, FRAME_X_WINDOW(f
),
3220 XNFocusWindow
, FRAME_X_WINDOW(f
),
3229 FRAME_XIM (f
) = xim
;
3230 FRAME_XIC (f
) = xic
;
3232 #else /* X_I18N_INHIBITED */
3235 #endif /* X_I18N_INHIBITED */
3236 #endif /* HAVE_X_I18N */
3238 f
->output_data
.x
->wm_hints
.input
= True
;
3239 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3240 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3241 &f
->output_data
.x
->wm_hints
);
3243 hack_wm_protocols (f
, shell_widget
);
3246 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3249 /* Do a stupid property change to force the server to generate a
3250 PropertyNotify event so that the event_stream server timestamp will
3251 be initialized to something relevant to the time we created the window.
3253 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3254 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3255 XA_ATOM
, 32, PropModeAppend
,
3256 (unsigned char*) NULL
, 0);
3258 /* Make all the standard events reach the Emacs frame. */
3259 attributes
.event_mask
= STANDARD_EVENT_SET
;
3260 attribute_mask
= CWEventMask
;
3261 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3262 attribute_mask
, &attributes
);
3264 XtMapWidget (frame_widget
);
3266 /* x_set_name normally ignores requests to set the name if the
3267 requested name is the same as the current name. This is the one
3268 place where that assumption isn't correct; f->name is set, but
3269 the X server hasn't been told. */
3272 int explicit = f
->explicit_name
;
3274 f
->explicit_name
= 0;
3277 x_set_name (f
, name
, explicit);
3280 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3281 f
->output_data
.x
->text_cursor
);
3285 /* This is a no-op, except under Motif. Make sure main areas are
3286 set to something reasonable, in case we get an error later. */
3287 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3290 #else /* not USE_X_TOOLKIT */
3292 /* Create and set up the X window for frame F. */
3299 XClassHint class_hints
;
3300 XSetWindowAttributes attributes
;
3301 unsigned long attribute_mask
;
3303 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3304 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3305 attributes
.bit_gravity
= StaticGravity
;
3306 attributes
.backing_store
= NotUseful
;
3307 attributes
.save_under
= True
;
3308 attributes
.event_mask
= STANDARD_EVENT_SET
;
3309 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3311 | CWBackingStore
| CWSaveUnder
3317 = XCreateWindow (FRAME_X_DISPLAY (f
),
3318 f
->output_data
.x
->parent_desc
,
3319 f
->output_data
.x
->left_pos
,
3320 f
->output_data
.x
->top_pos
,
3321 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3322 f
->output_data
.x
->border_width
,
3323 CopyFromParent
, /* depth */
3324 InputOutput
, /* class */
3325 FRAME_X_DISPLAY_INFO (f
)->visual
,
3326 attribute_mask
, &attributes
);
3328 #ifndef X_I18N_INHIBITED
3333 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3337 xic
= XCreateIC (xim
,
3338 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3339 XNClientWindow
, FRAME_X_WINDOW(f
),
3340 XNFocusWindow
, FRAME_X_WINDOW(f
),
3350 FRAME_XIM (f
) = xim
;
3351 FRAME_XIC (f
) = xic
;
3353 #else /* X_I18N_INHIBITED */
3356 #endif /* X_I18N_INHIBITED */
3357 #endif /* HAVE_X_I18N */
3359 validate_x_resource_name ();
3361 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3362 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3363 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3365 /* The menubar is part of the ordinary display;
3366 it does not count in addition to the height of the window. */
3367 f
->output_data
.x
->menubar_height
= 0;
3369 /* This indicates that we use the "Passive Input" input model.
3370 Unless we do this, we don't get the Focus{In,Out} events that we
3371 need to draw the cursor correctly. Accursed bureaucrats.
3372 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3374 f
->output_data
.x
->wm_hints
.input
= True
;
3375 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3376 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3377 &f
->output_data
.x
->wm_hints
);
3378 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3380 /* Request "save yourself" and "delete window" commands from wm. */
3383 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3384 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3385 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3388 /* x_set_name normally ignores requests to set the name if the
3389 requested name is the same as the current name. This is the one
3390 place where that assumption isn't correct; f->name is set, but
3391 the X server hasn't been told. */
3394 int explicit = f
->explicit_name
;
3396 f
->explicit_name
= 0;
3399 x_set_name (f
, name
, explicit);
3402 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3403 f
->output_data
.x
->text_cursor
);
3407 if (FRAME_X_WINDOW (f
) == 0)
3408 error ("Unable to create window");
3411 #endif /* not USE_X_TOOLKIT */
3413 /* Handle the icon stuff for this window. Perhaps later we might
3414 want an x_set_icon_position which can be called interactively as
3422 Lisp_Object icon_x
, icon_y
;
3423 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3425 /* Set the position of the icon. Note that twm groups all
3426 icons in an icon window. */
3427 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3428 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3429 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3431 CHECK_NUMBER (icon_x
, 0);
3432 CHECK_NUMBER (icon_y
, 0);
3434 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3435 error ("Both left and top icon corners of icon must be specified");
3439 if (! EQ (icon_x
, Qunbound
))
3440 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3442 /* Start up iconic or window? */
3443 x_wm_set_window_state
3444 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3449 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3456 /* Make the GC's needed for this window, setting the
3457 background, border and mouse colors; also create the
3458 mouse cursor and the gray border tile. */
3460 static char cursor_bits
[] =
3462 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3463 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3464 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3465 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3472 XGCValues gc_values
;
3476 /* Create the GC's of this frame.
3477 Note that many default values are used. */
3480 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3481 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3482 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3483 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3484 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3486 GCLineWidth
| GCFont
3487 | GCForeground
| GCBackground
,
3490 /* Reverse video style. */
3491 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3492 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3493 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3495 GCFont
| GCForeground
| GCBackground
3499 /* Cursor has cursor-color background, background-color foreground. */
3500 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3501 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3502 gc_values
.fill_style
= FillOpaqueStippled
;
3504 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3505 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3506 cursor_bits
, 16, 16);
3507 f
->output_data
.x
->cursor_gc
3508 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3509 (GCFont
| GCForeground
| GCBackground
3510 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3514 f
->output_data
.x
->white_relief
.gc
= 0;
3515 f
->output_data
.x
->black_relief
.gc
= 0;
3517 /* Create the gray border tile used when the pointer is not in
3518 the frame. Since this depends on the frame's pixel values,
3519 this must be done on a per-frame basis. */
3520 f
->output_data
.x
->border_tile
3521 = (XCreatePixmapFromBitmapData
3522 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3523 gray_bits
, gray_width
, gray_height
,
3524 f
->output_data
.x
->foreground_pixel
,
3525 f
->output_data
.x
->background_pixel
,
3526 DefaultDepth (FRAME_X_DISPLAY (f
),
3527 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3532 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3534 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3535 Returns an Emacs frame object.\n\
3536 ALIST is an alist of frame parameters.\n\
3537 If the parameters specify that the frame should not have a minibuffer,\n\
3538 and do not specify a specific minibuffer window to use,\n\
3539 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3540 be shared by the new frame.\n\
3542 This function is an internal primitive--use `make-frame' instead.")
3547 Lisp_Object frame
, tem
;
3549 int minibuffer_only
= 0;
3550 long window_prompting
= 0;
3552 int count
= specpdl_ptr
- specpdl
;
3553 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3554 Lisp_Object display
;
3555 struct x_display_info
*dpyinfo
= NULL
;
3561 /* Use this general default value to start with
3562 until we know if this frame has a specified name. */
3563 Vx_resource_name
= Vinvocation_name
;
3565 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3566 if (EQ (display
, Qunbound
))
3568 dpyinfo
= check_x_display_info (display
);
3570 kb
= dpyinfo
->kboard
;
3572 kb
= &the_only_kboard
;
3575 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3577 && ! EQ (name
, Qunbound
)
3579 error ("Invalid frame name--not a string or nil");
3582 Vx_resource_name
= name
;
3584 /* See if parent window is specified. */
3585 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3586 if (EQ (parent
, Qunbound
))
3588 if (! NILP (parent
))
3589 CHECK_NUMBER (parent
, 0);
3591 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3592 /* No need to protect DISPLAY because that's not used after passing
3593 it to make_frame_without_minibuffer. */
3595 GCPRO4 (parms
, parent
, name
, frame
);
3596 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3598 if (EQ (tem
, Qnone
) || NILP (tem
))
3599 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3600 else if (EQ (tem
, Qonly
))
3602 f
= make_minibuffer_frame ();
3603 minibuffer_only
= 1;
3605 else if (WINDOWP (tem
))
3606 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3610 XSETFRAME (frame
, f
);
3612 /* Note that X Windows does support scroll bars. */
3613 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3615 f
->output_method
= output_x_window
;
3616 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3617 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3618 f
->output_data
.x
->icon_bitmap
= -1;
3619 f
->output_data
.x
->fontset
= -1;
3620 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3621 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3624 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3626 if (! STRINGP (f
->icon_name
))
3627 f
->icon_name
= Qnil
;
3629 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3631 FRAME_KBOARD (f
) = kb
;
3634 /* Specify the parent under which to make this X window. */
3638 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3639 f
->output_data
.x
->explicit_parent
= 1;
3643 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3644 f
->output_data
.x
->explicit_parent
= 0;
3647 /* Set the name; the functions to which we pass f expect the name to
3649 if (EQ (name
, Qunbound
) || NILP (name
))
3651 f
->name
= build_string (dpyinfo
->x_id_name
);
3652 f
->explicit_name
= 0;
3657 f
->explicit_name
= 1;
3658 /* use the frame's title when getting resources for this frame. */
3659 specbind (Qx_resource_name
, name
);
3662 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3663 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3664 fs_register_fontset (f
, XCAR (tem
));
3666 /* Extract the window parameters from the supplied values
3667 that are needed to determine window geometry. */
3671 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3674 /* First, try whatever font the caller has specified. */
3677 tem
= Fquery_fontset (font
, Qnil
);
3679 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3681 font
= x_new_font (f
, XSTRING (font
)->data
);
3684 /* Try out a font which we hope has bold and italic variations. */
3685 if (!STRINGP (font
))
3686 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3687 if (!STRINGP (font
))
3688 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3689 if (! STRINGP (font
))
3690 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3691 if (! STRINGP (font
))
3692 /* This was formerly the first thing tried, but it finds too many fonts
3693 and takes too long. */
3694 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3695 /* If those didn't work, look for something which will at least work. */
3696 if (! STRINGP (font
))
3697 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3699 if (! STRINGP (font
))
3700 font
= build_string ("fixed");
3702 x_default_parameter (f
, parms
, Qfont
, font
,
3703 "font", "Font", RES_TYPE_STRING
);
3707 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3708 whereby it fails to get any font. */
3709 xlwmenu_default_font
= f
->output_data
.x
->font
;
3712 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3713 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3715 /* This defaults to 2 in order to match xterm. We recognize either
3716 internalBorderWidth or internalBorder (which is what xterm calls
3718 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3722 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3723 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3724 if (! EQ (value
, Qunbound
))
3725 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3728 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3729 "internalBorderWidth", "internalBorderWidth",
3731 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3732 "verticalScrollBars", "ScrollBars",
3735 /* Also do the stuff which must be set before the window exists. */
3736 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3737 "foreground", "Foreground", RES_TYPE_STRING
);
3738 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3739 "background", "Background", RES_TYPE_STRING
);
3740 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3741 "pointerColor", "Foreground", RES_TYPE_STRING
);
3742 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3743 "cursorColor", "Foreground", RES_TYPE_STRING
);
3744 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3745 "borderColor", "BorderColor", RES_TYPE_STRING
);
3746 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3747 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3749 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3750 "scrollBarForeground",
3751 "ScrollBarForeground", 1);
3752 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3753 "scrollBarBackground",
3754 "ScrollBarBackground", 0);
3756 /* Init faces before x_default_parameter is called for scroll-bar
3757 parameters because that function calls x_set_scroll_bar_width,
3758 which calls change_frame_size, which calls Fset_window_buffer,
3759 which runs hooks, which call Fvertical_motion. At the end, we
3760 end up in init_iterator with a null face cache, which should not
3762 init_frame_faces (f
);
3764 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3765 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3766 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3767 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3768 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3769 "scrollBarWidth", "ScrollBarWidth",
3771 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3772 "bufferPredicate", "BufferPredicate",
3774 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3775 "title", "Title", RES_TYPE_STRING
);
3777 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3778 window_prompting
= x_figure_window_size (f
, parms
);
3780 if (window_prompting
& XNegative
)
3782 if (window_prompting
& YNegative
)
3783 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3785 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3789 if (window_prompting
& YNegative
)
3790 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3792 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3795 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3797 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3798 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3800 /* Create the X widget or window. Add the tool-bar height to the
3801 initial frame height so that the user gets a text display area of
3802 the size he specified with -g or via .Xdefaults. Later changes
3803 of the tool-bar height don't change the frame size. This is done
3804 so that users can create tall Emacs frames without having to
3805 guess how tall the tool-bar will get. */
3806 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3808 #ifdef USE_X_TOOLKIT
3809 x_window (f
, window_prompting
, minibuffer_only
);
3817 /* Now consider the frame official. */
3818 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3819 Vframe_list
= Fcons (frame
, Vframe_list
);
3821 /* We need to do this after creating the X window, so that the
3822 icon-creation functions can say whose icon they're describing. */
3823 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3824 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3826 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3827 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3828 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3829 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3830 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3831 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3833 /* Dimensions, especially f->height, must be done via change_frame_size.
3834 Change will not be effected unless different from the current
3839 SET_FRAME_WIDTH (f
, 0);
3840 change_frame_size (f
, height
, width
, 1, 0, 0);
3842 /* Set up faces after all frame parameters are known. */
3843 call1 (Qface_set_after_frame_default
, frame
);
3845 #ifdef USE_X_TOOLKIT
3846 /* Create the menu bar. */
3847 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3849 /* If this signals an error, we haven't set size hints for the
3850 frame and we didn't make it visible. */
3851 initialize_frame_menubar (f
);
3853 /* This is a no-op, except under Motif where it arranges the
3854 main window for the widgets on it. */
3855 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3856 f
->output_data
.x
->menubar_widget
,
3857 f
->output_data
.x
->edit_widget
);
3859 #endif /* USE_X_TOOLKIT */
3861 /* Tell the server what size and position, etc, we want, and how
3862 badly we want them. This should be done after we have the menu
3863 bar so that its size can be taken into account. */
3865 x_wm_set_size_hint (f
, window_prompting
, 0);
3868 /* Make the window appear on the frame and enable display, unless
3869 the caller says not to. However, with explicit parent, Emacs
3870 cannot control visibility, so don't try. */
3871 if (! f
->output_data
.x
->explicit_parent
)
3873 Lisp_Object visibility
;
3875 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3877 if (EQ (visibility
, Qunbound
))
3880 if (EQ (visibility
, Qicon
))
3881 x_iconify_frame (f
);
3882 else if (! NILP (visibility
))
3883 x_make_frame_visible (f
);
3885 /* Must have been Qnil. */
3890 return unbind_to (count
, frame
);
3893 /* FRAME is used only to get a handle on the X display. We don't pass the
3894 display info directly because we're called from frame.c, which doesn't
3895 know about that structure. */
3898 x_get_focus_frame (frame
)
3899 struct frame
*frame
;
3901 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3903 if (! dpyinfo
->x_focus_frame
)
3906 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3911 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
3912 "Internal function called by `color-defined-p', which see.")
3914 Lisp_Object color
, frame
;
3917 FRAME_PTR f
= check_x_frame (frame
);
3919 CHECK_STRING (color
, 1);
3921 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3927 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
3928 "Internal function called by `color-values', which see.")
3930 Lisp_Object color
, frame
;
3933 FRAME_PTR f
= check_x_frame (frame
);
3935 CHECK_STRING (color
, 1);
3937 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3941 rgb
[0] = make_number (foo
.red
);
3942 rgb
[1] = make_number (foo
.green
);
3943 rgb
[2] = make_number (foo
.blue
);
3944 return Flist (3, rgb
);
3950 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
3951 "Internal function called by `display-color-p', which see.")
3953 Lisp_Object display
;
3955 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3957 if (dpyinfo
->n_planes
<= 2)
3960 switch (dpyinfo
->visual
->class)
3973 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3975 "Return t if the X display supports shades of gray.\n\
3976 Note that color displays do support shades of gray.\n\
3977 The optional argument DISPLAY specifies which display to ask about.\n\
3978 DISPLAY should be either a frame or a display name (a string).\n\
3979 If omitted or nil, that stands for the selected frame's display.")
3981 Lisp_Object display
;
3983 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3985 if (dpyinfo
->n_planes
<= 1)
3988 switch (dpyinfo
->visual
->class)
4003 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4005 "Returns the width in pixels of the X display DISPLAY.\n\
4006 The optional argument DISPLAY specifies which display to ask about.\n\
4007 DISPLAY should be either a frame or a display name (a string).\n\
4008 If omitted or nil, that stands for the selected frame's display.")
4010 Lisp_Object display
;
4012 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4014 return make_number (dpyinfo
->width
);
4017 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4018 Sx_display_pixel_height
, 0, 1, 0,
4019 "Returns the height in pixels of the X display DISPLAY.\n\
4020 The optional argument DISPLAY specifies which display to ask about.\n\
4021 DISPLAY should be either a frame or a display name (a string).\n\
4022 If omitted or nil, that stands for the selected frame's display.")
4024 Lisp_Object display
;
4026 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4028 return make_number (dpyinfo
->height
);
4031 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4033 "Returns the number of bitplanes of the X display DISPLAY.\n\
4034 The optional argument DISPLAY specifies which display to ask about.\n\
4035 DISPLAY should be either a frame or a display name (a string).\n\
4036 If omitted or nil, that stands for the selected frame's display.")
4038 Lisp_Object display
;
4040 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4042 return make_number (dpyinfo
->n_planes
);
4045 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4047 "Returns the number of color cells of the X display DISPLAY.\n\
4048 The optional argument DISPLAY specifies which display to ask about.\n\
4049 DISPLAY should be either a frame or a display name (a string).\n\
4050 If omitted or nil, that stands for the selected frame's display.")
4052 Lisp_Object display
;
4054 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4056 return make_number (DisplayCells (dpyinfo
->display
,
4057 XScreenNumberOfScreen (dpyinfo
->screen
)));
4060 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4061 Sx_server_max_request_size
,
4063 "Returns the maximum request size of the X server of display DISPLAY.\n\
4064 The optional argument DISPLAY specifies which display to ask about.\n\
4065 DISPLAY should be either a frame or a display name (a string).\n\
4066 If omitted or nil, that stands for the selected frame's display.")
4068 Lisp_Object display
;
4070 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4072 return make_number (MAXREQUEST (dpyinfo
->display
));
4075 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4076 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4077 The optional argument DISPLAY specifies which display to ask about.\n\
4078 DISPLAY should be either a frame or a display name (a string).\n\
4079 If omitted or nil, that stands for the selected frame's display.")
4081 Lisp_Object display
;
4083 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4084 char *vendor
= ServerVendor (dpyinfo
->display
);
4086 if (! vendor
) vendor
= "";
4087 return build_string (vendor
);
4090 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4091 "Returns the version numbers of the X server of display DISPLAY.\n\
4092 The value is a list of three integers: the major and minor\n\
4093 version numbers of the X Protocol in use, and the vendor-specific release\n\
4094 number. See also the function `x-server-vendor'.\n\n\
4095 The optional argument DISPLAY specifies which display to ask about.\n\
4096 DISPLAY should be either a frame or a display name (a string).\n\
4097 If omitted or nil, that stands for the selected frame's display.")
4099 Lisp_Object display
;
4101 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4102 Display
*dpy
= dpyinfo
->display
;
4104 return Fcons (make_number (ProtocolVersion (dpy
)),
4105 Fcons (make_number (ProtocolRevision (dpy
)),
4106 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4109 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4110 "Returns the number of screens on the X server of display DISPLAY.\n\
4111 The optional argument DISPLAY specifies which display to ask about.\n\
4112 DISPLAY should be either a frame or a display name (a string).\n\
4113 If omitted or nil, that stands for the selected frame's display.")
4115 Lisp_Object display
;
4117 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4119 return make_number (ScreenCount (dpyinfo
->display
));
4122 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4123 "Returns the height in millimeters of the X display DISPLAY.\n\
4124 The optional argument DISPLAY specifies which display to ask about.\n\
4125 DISPLAY should be either a frame or a display name (a string).\n\
4126 If omitted or nil, that stands for the selected frame's display.")
4128 Lisp_Object display
;
4130 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4132 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4135 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4136 "Returns the width in millimeters of the X display DISPLAY.\n\
4137 The optional argument DISPLAY specifies which display to ask about.\n\
4138 DISPLAY should be either a frame or a display name (a string).\n\
4139 If omitted or nil, that stands for the selected frame's display.")
4141 Lisp_Object display
;
4143 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4145 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4148 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4149 Sx_display_backing_store
, 0, 1, 0,
4150 "Returns an indication of whether X display DISPLAY does backing store.\n\
4151 The value may be `always', `when-mapped', or `not-useful'.\n\
4152 The optional argument DISPLAY specifies which display to ask about.\n\
4153 DISPLAY should be either a frame or a display name (a string).\n\
4154 If omitted or nil, that stands for the selected frame's display.")
4156 Lisp_Object display
;
4158 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4160 switch (DoesBackingStore (dpyinfo
->screen
))
4163 return intern ("always");
4166 return intern ("when-mapped");
4169 return intern ("not-useful");
4172 error ("Strange value for BackingStore parameter of screen");
4176 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4177 Sx_display_visual_class
, 0, 1, 0,
4178 "Returns the visual class of the X display DISPLAY.\n\
4179 The value is one of the symbols `static-gray', `gray-scale',\n\
4180 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4181 The optional argument DISPLAY specifies which display to ask about.\n\
4182 DISPLAY should be either a frame or a display name (a string).\n\
4183 If omitted or nil, that stands for the selected frame's display.")
4185 Lisp_Object display
;
4187 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4189 switch (dpyinfo
->visual
->class)
4191 case StaticGray
: return (intern ("static-gray"));
4192 case GrayScale
: return (intern ("gray-scale"));
4193 case StaticColor
: return (intern ("static-color"));
4194 case PseudoColor
: return (intern ("pseudo-color"));
4195 case TrueColor
: return (intern ("true-color"));
4196 case DirectColor
: return (intern ("direct-color"));
4198 error ("Display has an unknown visual class");
4202 DEFUN ("x-display-save-under", Fx_display_save_under
,
4203 Sx_display_save_under
, 0, 1, 0,
4204 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4205 The optional argument DISPLAY specifies which display to ask about.\n\
4206 DISPLAY should be either a frame or a display name (a string).\n\
4207 If omitted or nil, that stands for the selected frame's display.")
4209 Lisp_Object display
;
4211 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4213 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4221 register struct frame
*f
;
4223 return PIXEL_WIDTH (f
);
4228 register struct frame
*f
;
4230 return PIXEL_HEIGHT (f
);
4235 register struct frame
*f
;
4237 return FONT_WIDTH (f
->output_data
.x
->font
);
4242 register struct frame
*f
;
4244 return f
->output_data
.x
->line_height
;
4249 register struct frame
*f
;
4251 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4254 #if 0 /* These no longer seem like the right way to do things. */
4256 /* Draw a rectangle on the frame with left top corner including
4257 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4258 CHARS by LINES wide and long and is the color of the cursor. */
4261 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4262 register struct frame
*f
;
4264 register int top_char
, left_char
, chars
, lines
;
4268 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4269 + f
->output_data
.x
->internal_border_width
);
4270 int top
= (top_char
* f
->output_data
.x
->line_height
4271 + f
->output_data
.x
->internal_border_width
);
4274 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4276 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4278 height
= f
->output_data
.x
->line_height
/ 2;
4280 height
= f
->output_data
.x
->line_height
* lines
;
4282 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4283 gc
, left
, top
, width
, height
);
4286 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4287 "Draw a rectangle on FRAME between coordinates specified by\n\
4288 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4289 (frame
, X0
, Y0
, X1
, Y1
)
4290 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4292 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4294 CHECK_LIVE_FRAME (frame
, 0);
4295 CHECK_NUMBER (X0
, 0);
4296 CHECK_NUMBER (Y0
, 1);
4297 CHECK_NUMBER (X1
, 2);
4298 CHECK_NUMBER (Y1
, 3);
4308 n_lines
= y1
- y0
+ 1;
4313 n_lines
= y0
- y1
+ 1;
4319 n_chars
= x1
- x0
+ 1;
4324 n_chars
= x0
- x1
+ 1;
4328 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4329 left
, top
, n_chars
, n_lines
);
4335 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4336 "Draw a rectangle drawn on FRAME between coordinates\n\
4337 X0, Y0, X1, Y1 in the regular background-pixel.")
4338 (frame
, X0
, Y0
, X1
, Y1
)
4339 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4341 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4343 CHECK_LIVE_FRAME (frame
, 0);
4344 CHECK_NUMBER (X0
, 0);
4345 CHECK_NUMBER (Y0
, 1);
4346 CHECK_NUMBER (X1
, 2);
4347 CHECK_NUMBER (Y1
, 3);
4357 n_lines
= y1
- y0
+ 1;
4362 n_lines
= y0
- y1
+ 1;
4368 n_chars
= x1
- x0
+ 1;
4373 n_chars
= x0
- x1
+ 1;
4377 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4378 left
, top
, n_chars
, n_lines
);
4384 /* Draw lines around the text region beginning at the character position
4385 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4386 pixel and line characteristics. */
4388 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4391 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4392 register struct frame
*f
;
4394 int top_x
, top_y
, bottom_x
, bottom_y
;
4396 register int ibw
= f
->output_data
.x
->internal_border_width
;
4397 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4398 register int font_h
= f
->output_data
.x
->line_height
;
4400 int x
= line_len (y
);
4401 XPoint
*pixel_points
4402 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4403 register XPoint
*this_point
= pixel_points
;
4405 /* Do the horizontal top line/lines */
4408 this_point
->x
= ibw
;
4409 this_point
->y
= ibw
+ (font_h
* top_y
);
4412 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4414 this_point
->x
= ibw
+ (font_w
* x
);
4415 this_point
->y
= (this_point
- 1)->y
;
4419 this_point
->x
= ibw
;
4420 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4422 this_point
->x
= ibw
+ (font_w
* top_x
);
4423 this_point
->y
= (this_point
- 1)->y
;
4425 this_point
->x
= (this_point
- 1)->x
;
4426 this_point
->y
= ibw
+ (font_h
* top_y
);
4428 this_point
->x
= ibw
+ (font_w
* x
);
4429 this_point
->y
= (this_point
- 1)->y
;
4432 /* Now do the right side. */
4433 while (y
< bottom_y
)
4434 { /* Right vertical edge */
4436 this_point
->x
= (this_point
- 1)->x
;
4437 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4440 y
++; /* Horizontal connection to next line */
4443 this_point
->x
= ibw
+ (font_w
/ 2);
4445 this_point
->x
= ibw
+ (font_w
* x
);
4447 this_point
->y
= (this_point
- 1)->y
;
4450 /* Now do the bottom and connect to the top left point. */
4451 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4454 this_point
->x
= (this_point
- 1)->x
;
4455 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4457 this_point
->x
= ibw
;
4458 this_point
->y
= (this_point
- 1)->y
;
4460 this_point
->x
= pixel_points
->x
;
4461 this_point
->y
= pixel_points
->y
;
4463 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4465 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4468 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4469 "Highlight the region between point and the character under the mouse\n\
4472 register Lisp_Object event
;
4474 register int x0
, y0
, x1
, y1
;
4475 register struct frame
*f
= selected_frame
;
4476 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4477 register int p1
, p2
;
4479 CHECK_CONS (event
, 0);
4482 x0
= XINT (Fcar (Fcar (event
)));
4483 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4485 /* If the mouse is past the end of the line, don't that area. */
4486 /* ReWrite this... */
4488 /* Where the cursor is. */
4489 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4490 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4492 if (y1
> y0
) /* point below mouse */
4493 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4495 else if (y1
< y0
) /* point above mouse */
4496 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4498 else /* same line: draw horizontal rectangle */
4501 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4502 x0
, y0
, (x1
- x0
+ 1), 1);
4504 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4505 x1
, y1
, (x0
- x1
+ 1), 1);
4508 XFlush (FRAME_X_DISPLAY (f
));
4514 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4515 "Erase any highlighting of the region between point and the character\n\
4516 at X, Y on the selected frame.")
4518 register Lisp_Object event
;
4520 register int x0
, y0
, x1
, y1
;
4521 register struct frame
*f
= selected_frame
;
4522 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4525 x0
= XINT (Fcar (Fcar (event
)));
4526 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4527 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4528 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4530 if (y1
> y0
) /* point below mouse */
4531 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4533 else if (y1
< y0
) /* point above mouse */
4534 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4536 else /* same line: draw horizontal rectangle */
4539 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4540 x0
, y0
, (x1
- x0
+ 1), 1);
4542 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4543 x1
, y1
, (x0
- x1
+ 1), 1);
4551 int contour_begin_x
, contour_begin_y
;
4552 int contour_end_x
, contour_end_y
;
4553 int contour_npoints
;
4555 /* Clip the top part of the contour lines down (and including) line Y_POS.
4556 If X_POS is in the middle (rather than at the end) of the line, drop
4557 down a line at that character. */
4560 clip_contour_top (y_pos
, x_pos
)
4562 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4563 register XPoint
*end
;
4564 register int npoints
;
4565 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4567 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4569 end
= contour_lines
[y_pos
].top_right
;
4570 npoints
= (end
- begin
+ 1);
4571 XDrawLines (x_current_display
, contour_window
,
4572 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4574 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4575 contour_last_point
-= (npoints
- 2);
4576 XDrawLines (x_current_display
, contour_window
,
4577 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4578 XFlush (x_current_display
);
4580 /* Now, update contour_lines structure. */
4585 register XPoint
*p
= begin
+ 1;
4586 end
= contour_lines
[y_pos
].bottom_right
;
4587 npoints
= (end
- begin
+ 1);
4588 XDrawLines (x_current_display
, contour_window
,
4589 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4592 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4594 p
->y
= begin
->y
+ font_h
;
4596 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4597 contour_last_point
-= (npoints
- 5);
4598 XDrawLines (x_current_display
, contour_window
,
4599 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4600 XFlush (x_current_display
);
4602 /* Now, update contour_lines structure. */
4606 /* Erase the top horizontal lines of the contour, and then extend
4607 the contour upwards. */
4610 extend_contour_top (line
)
4615 clip_contour_bottom (x_pos
, y_pos
)
4621 extend_contour_bottom (x_pos
, y_pos
)
4625 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4630 register struct frame
*f
= selected_frame
;
4631 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4632 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4633 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4634 register int mouse_below_point
;
4635 register Lisp_Object obj
;
4636 register int x_contour_x
, x_contour_y
;
4638 x_contour_x
= x_mouse_x
;
4639 x_contour_y
= x_mouse_y
;
4640 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4641 && x_contour_x
> point_x
))
4643 mouse_below_point
= 1;
4644 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4645 x_contour_x
, x_contour_y
);
4649 mouse_below_point
= 0;
4650 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4656 obj
= read_char (-1, 0, 0, Qnil
, 0);
4660 if (mouse_below_point
)
4662 if (x_mouse_y
<= point_y
) /* Flipped. */
4664 mouse_below_point
= 0;
4666 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4667 x_contour_x
, x_contour_y
);
4668 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4671 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4673 clip_contour_bottom (x_mouse_y
);
4675 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4677 extend_bottom_contour (x_mouse_y
);
4680 x_contour_x
= x_mouse_x
;
4681 x_contour_y
= x_mouse_y
;
4683 else /* mouse above or same line as point */
4685 if (x_mouse_y
>= point_y
) /* Flipped. */
4687 mouse_below_point
= 1;
4689 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4690 x_contour_x
, x_contour_y
, point_x
, point_y
);
4691 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4692 x_mouse_x
, x_mouse_y
);
4694 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4696 clip_contour_top (x_mouse_y
);
4698 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4700 extend_contour_top (x_mouse_y
);
4705 unread_command_event
= obj
;
4706 if (mouse_below_point
)
4708 contour_begin_x
= point_x
;
4709 contour_begin_y
= point_y
;
4710 contour_end_x
= x_contour_x
;
4711 contour_end_y
= x_contour_y
;
4715 contour_begin_x
= x_contour_x
;
4716 contour_begin_y
= x_contour_y
;
4717 contour_end_x
= point_x
;
4718 contour_end_y
= point_y
;
4723 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4728 register Lisp_Object obj
;
4729 struct frame
*f
= selected_frame
;
4730 register struct window
*w
= XWINDOW (selected_window
);
4731 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4732 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4734 char dash_list
[] = {6, 4, 6, 4};
4736 XGCValues gc_values
;
4738 register int previous_y
;
4739 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4740 + f
->output_data
.x
->internal_border_width
;
4741 register int left
= f
->output_data
.x
->internal_border_width
4742 + (WINDOW_LEFT_MARGIN (w
)
4743 * FONT_WIDTH (f
->output_data
.x
->font
));
4744 register int right
= left
+ (w
->width
4745 * FONT_WIDTH (f
->output_data
.x
->font
))
4746 - f
->output_data
.x
->internal_border_width
;
4750 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4751 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4752 gc_values
.line_width
= 1;
4753 gc_values
.line_style
= LineOnOffDash
;
4754 gc_values
.cap_style
= CapRound
;
4755 gc_values
.join_style
= JoinRound
;
4757 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4758 GCLineStyle
| GCJoinStyle
| GCCapStyle
4759 | GCLineWidth
| GCForeground
| GCBackground
,
4761 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4762 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4763 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4764 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4765 GCLineStyle
| GCJoinStyle
| GCCapStyle
4766 | GCLineWidth
| GCForeground
| GCBackground
,
4768 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4775 if (x_mouse_y
>= XINT (w
->top
)
4776 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4778 previous_y
= x_mouse_y
;
4779 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4780 + f
->output_data
.x
->internal_border_width
;
4781 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4782 line_gc
, left
, line
, right
, line
);
4784 XFlush (FRAME_X_DISPLAY (f
));
4789 obj
= read_char (-1, 0, 0, Qnil
, 0);
4791 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4792 Qvertical_scroll_bar
))
4796 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4797 erase_gc
, left
, line
, right
, line
);
4798 unread_command_event
= obj
;
4800 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4801 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4807 while (x_mouse_y
== previous_y
);
4810 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4811 erase_gc
, left
, line
, right
, line
);
4818 /* These keep track of the rectangle following the pointer. */
4819 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4821 /* Offset in buffer of character under the pointer, or 0. */
4822 int mouse_buffer_offset
;
4824 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4825 "Track the pointer.")
4828 static Cursor current_pointer_shape
;
4829 FRAME_PTR f
= x_mouse_frame
;
4832 if (EQ (Vmouse_frame_part
, Qtext_part
)
4833 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4838 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4839 XDefineCursor (FRAME_X_DISPLAY (f
),
4841 current_pointer_shape
);
4843 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4844 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4846 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4847 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4849 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4850 XDefineCursor (FRAME_X_DISPLAY (f
),
4852 current_pointer_shape
);
4855 XFlush (FRAME_X_DISPLAY (f
));
4861 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4862 "Draw rectangle around character under mouse pointer, if there is one.")
4866 struct window
*w
= XWINDOW (Vmouse_window
);
4867 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4868 struct buffer
*b
= XBUFFER (w
->buffer
);
4871 if (! EQ (Vmouse_window
, selected_window
))
4874 if (EQ (event
, Qnil
))
4878 x_read_mouse_position (selected_frame
, &x
, &y
);
4882 mouse_track_width
= 0;
4883 mouse_track_left
= mouse_track_top
= -1;
4887 if ((x_mouse_x
!= mouse_track_left
4888 && (x_mouse_x
< mouse_track_left
4889 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4890 || x_mouse_y
!= mouse_track_top
)
4892 int hp
= 0; /* Horizontal position */
4893 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4894 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4895 int tab_width
= XINT (b
->tab_width
);
4896 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4898 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4899 int in_mode_line
= 0;
4901 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4904 /* Erase previous rectangle. */
4905 if (mouse_track_width
)
4907 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4908 mouse_track_left
, mouse_track_top
,
4909 mouse_track_width
, 1);
4911 if ((mouse_track_left
== f
->phys_cursor_x
4912 || mouse_track_left
== f
->phys_cursor_x
- 1)
4913 && mouse_track_top
== f
->phys_cursor_y
)
4915 x_display_cursor (f
, 1);
4919 mouse_track_left
= x_mouse_x
;
4920 mouse_track_top
= x_mouse_y
;
4921 mouse_track_width
= 0;
4923 if (mouse_track_left
> len
) /* Past the end of line. */
4926 if (mouse_track_top
== mode_line_vpos
)
4932 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4936 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4942 mouse_track_width
= tab_width
- (hp
% tab_width
);
4944 hp
+= mouse_track_width
;
4947 mouse_track_left
= hp
- mouse_track_width
;
4953 mouse_track_width
= -1;
4957 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4962 mouse_track_width
= 2;
4967 mouse_track_left
= hp
- mouse_track_width
;
4973 mouse_track_width
= 1;
4980 while (hp
<= x_mouse_x
);
4983 if (mouse_track_width
) /* Over text; use text pointer shape. */
4985 XDefineCursor (FRAME_X_DISPLAY (f
),
4987 f
->output_data
.x
->text_cursor
);
4988 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4989 mouse_track_left
, mouse_track_top
,
4990 mouse_track_width
, 1);
4992 else if (in_mode_line
)
4993 XDefineCursor (FRAME_X_DISPLAY (f
),
4995 f
->output_data
.x
->modeline_cursor
);
4997 XDefineCursor (FRAME_X_DISPLAY (f
),
4999 f
->output_data
.x
->nontext_cursor
);
5002 XFlush (FRAME_X_DISPLAY (f
));
5005 obj
= read_char (-1, 0, 0, Qnil
, 0);
5008 while (CONSP (obj
) /* Mouse event */
5009 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5010 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5011 && EQ (Vmouse_window
, selected_window
) /* In this window */
5014 unread_command_event
= obj
;
5016 if (mouse_track_width
)
5018 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5019 mouse_track_left
, mouse_track_top
,
5020 mouse_track_width
, 1);
5021 mouse_track_width
= 0;
5022 if ((mouse_track_left
== f
->phys_cursor_x
5023 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5024 && mouse_track_top
== f
->phys_cursor_y
)
5026 x_display_cursor (f
, 1);
5029 XDefineCursor (FRAME_X_DISPLAY (f
),
5031 f
->output_data
.x
->nontext_cursor
);
5032 XFlush (FRAME_X_DISPLAY (f
));
5042 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5043 on the frame F at position X, Y. */
5045 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5047 int x
, y
, width
, height
;
5052 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5053 FRAME_X_WINDOW (f
), image_data
,
5055 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5056 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5060 #if 0 /* I'm told these functions are superfluous
5061 given the ability to bind function keys. */
5064 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5065 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5066 KEYSYM is a string which conforms to the X keysym definitions found\n\
5067 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5068 list of strings specifying modifier keys such as Control_L, which must\n\
5069 also be depressed for NEWSTRING to appear.")
5070 (x_keysym
, modifiers
, newstring
)
5071 register Lisp_Object x_keysym
;
5072 register Lisp_Object modifiers
;
5073 register Lisp_Object newstring
;
5076 register KeySym keysym
;
5077 KeySym modifier_list
[16];
5080 CHECK_STRING (x_keysym
, 1);
5081 CHECK_STRING (newstring
, 3);
5083 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5084 if (keysym
== NoSymbol
)
5085 error ("Keysym does not exist");
5087 if (NILP (modifiers
))
5088 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5089 XSTRING (newstring
)->data
,
5090 STRING_BYTES (XSTRING (newstring
)));
5093 register Lisp_Object rest
, mod
;
5096 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5099 error ("Can't have more than 16 modifiers");
5102 CHECK_STRING (mod
, 3);
5103 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5105 if (modifier_list
[i
] == NoSymbol
5106 || !(IsModifierKey (modifier_list
[i
])
5107 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5108 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5110 if (modifier_list
[i
] == NoSymbol
5111 || !IsModifierKey (modifier_list
[i
]))
5113 error ("Element is not a modifier keysym");
5117 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5118 XSTRING (newstring
)->data
,
5119 STRING_BYTES (XSTRING (newstring
)));
5125 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5126 "Rebind KEYCODE to list of strings STRINGS.\n\
5127 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5128 nil as element means don't change.\n\
5129 See the documentation of `x-rebind-key' for more information.")
5131 register Lisp_Object keycode
;
5132 register Lisp_Object strings
;
5134 register Lisp_Object item
;
5135 register unsigned char *rawstring
;
5136 KeySym rawkey
, modifier
[1];
5138 register unsigned i
;
5141 CHECK_NUMBER (keycode
, 1);
5142 CHECK_CONS (strings
, 2);
5143 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5144 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5146 item
= Fcar (strings
);
5149 CHECK_STRING (item
, 2);
5150 strsize
= STRING_BYTES (XSTRING (item
));
5151 rawstring
= (unsigned char *) xmalloc (strsize
);
5152 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5153 modifier
[1] = 1 << i
;
5154 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5155 rawstring
, strsize
);
5160 #endif /* HAVE_X11 */
5163 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5165 XScreenNumberOfScreen (scr
)
5166 register Screen
*scr
;
5168 register Display
*dpy
;
5169 register Screen
*dpyscr
;
5173 dpyscr
= dpy
->screens
;
5175 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5181 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5184 select_visual (dpy
, screen
, depth
)
5187 unsigned int *depth
;
5190 XVisualInfo
*vinfo
, vinfo_template
;
5193 v
= DefaultVisualOfScreen (screen
);
5196 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5198 vinfo_template
.visualid
= v
->visualid
;
5201 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5203 vinfo
= XGetVisualInfo (dpy
,
5204 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5207 fatal ("Can't get proper X visual info");
5209 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5210 *depth
= vinfo
->depth
;
5214 int n
= vinfo
->colormap_size
- 1;
5223 XFree ((char *) vinfo
);
5227 /* Return the X display structure for the display named NAME.
5228 Open a new connection if necessary. */
5230 struct x_display_info
*
5231 x_display_info_for_name (name
)
5235 struct x_display_info
*dpyinfo
;
5237 CHECK_STRING (name
, 0);
5239 if (! EQ (Vwindow_system
, intern ("x")))
5240 error ("Not using X Windows");
5242 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5244 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5247 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5252 /* Use this general default value to start with. */
5253 Vx_resource_name
= Vinvocation_name
;
5255 validate_x_resource_name ();
5257 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5258 (char *) XSTRING (Vx_resource_name
)->data
);
5261 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5264 XSETFASTINT (Vwindow_system_version
, 11);
5269 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5270 1, 3, 0, "Open a connection to an X server.\n\
5271 DISPLAY is the name of the display to connect to.\n\
5272 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5273 If the optional third arg MUST-SUCCEED is non-nil,\n\
5274 terminate Emacs if we can't open the connection.")
5275 (display
, xrm_string
, must_succeed
)
5276 Lisp_Object display
, xrm_string
, must_succeed
;
5278 unsigned char *xrm_option
;
5279 struct x_display_info
*dpyinfo
;
5281 CHECK_STRING (display
, 0);
5282 if (! NILP (xrm_string
))
5283 CHECK_STRING (xrm_string
, 1);
5285 if (! EQ (Vwindow_system
, intern ("x")))
5286 error ("Not using X Windows");
5288 if (! NILP (xrm_string
))
5289 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5291 xrm_option
= (unsigned char *) 0;
5293 validate_x_resource_name ();
5295 /* This is what opens the connection and sets x_current_display.
5296 This also initializes many symbols, such as those used for input. */
5297 dpyinfo
= x_term_init (display
, xrm_option
,
5298 (char *) XSTRING (Vx_resource_name
)->data
);
5302 if (!NILP (must_succeed
))
5303 fatal ("Cannot connect to X server %s.\n\
5304 Check the DISPLAY environment variable or use `-d'.\n\
5305 Also use the `xhost' program to verify that it is set to permit\n\
5306 connections from your machine.\n",
5307 XSTRING (display
)->data
);
5309 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5314 XSETFASTINT (Vwindow_system_version
, 11);
5318 DEFUN ("x-close-connection", Fx_close_connection
,
5319 Sx_close_connection
, 1, 1, 0,
5320 "Close the connection to DISPLAY's X server.\n\
5321 For DISPLAY, specify either a frame or a display name (a string).\n\
5322 If DISPLAY is nil, that stands for the selected frame's display.")
5324 Lisp_Object display
;
5326 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5329 if (dpyinfo
->reference_count
> 0)
5330 error ("Display still has frames on it");
5333 /* Free the fonts in the font table. */
5334 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5335 if (dpyinfo
->font_table
[i
].name
)
5337 xfree (dpyinfo
->font_table
[i
].name
);
5338 /* Don't free the full_name string;
5339 it is always shared with something else. */
5340 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5343 x_destroy_all_bitmaps (dpyinfo
);
5344 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5346 #ifdef USE_X_TOOLKIT
5347 XtCloseDisplay (dpyinfo
->display
);
5349 XCloseDisplay (dpyinfo
->display
);
5352 x_delete_display (dpyinfo
);
5358 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5359 "Return the list of display names that Emacs has connections to.")
5362 Lisp_Object tail
, result
;
5365 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5366 result
= Fcons (XCAR (XCAR (tail
)), result
);
5371 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5372 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5373 If ON is nil, allow buffering of requests.\n\
5374 Turning on synchronization prohibits the Xlib routines from buffering\n\
5375 requests and seriously degrades performance, but makes debugging much\n\
5377 The optional second argument DISPLAY specifies which display to act on.\n\
5378 DISPLAY should be either a frame or a display name (a string).\n\
5379 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5381 Lisp_Object display
, on
;
5383 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5385 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5390 /* Wait for responses to all X commands issued so far for frame F. */
5397 XSync (FRAME_X_DISPLAY (f
), False
);
5402 /***********************************************************************
5404 ***********************************************************************/
5406 /* Value is the number of elements of vector VECTOR. */
5408 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5410 /* List of supported image types. Use define_image_type to add new
5411 types. Use lookup_image_type to find a type for a given symbol. */
5413 static struct image_type
*image_types
;
5415 /* A list of symbols, one for each supported image type. */
5417 Lisp_Object Vimage_types
;
5419 /* The symbol `image' which is the car of the lists used to represent
5422 extern Lisp_Object Qimage
;
5424 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5430 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5431 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5432 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5433 Lisp_Object QCindex
;
5435 /* Other symbols. */
5437 Lisp_Object Qlaplace
;
5439 /* Time in seconds after which images should be removed from the cache
5440 if not displayed. */
5442 Lisp_Object Vimage_cache_eviction_delay
;
5444 /* Function prototypes. */
5446 static void define_image_type
P_ ((struct image_type
*type
));
5447 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5448 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5449 static void x_laplace
P_ ((struct frame
*, struct image
*));
5450 static int x_build_heuristic_mask
P_ ((struct frame
*, Lisp_Object
,
5451 struct image
*, Lisp_Object
));
5454 /* Define a new image type from TYPE. This adds a copy of TYPE to
5455 image_types and adds the symbol *TYPE->type to Vimage_types. */
5458 define_image_type (type
)
5459 struct image_type
*type
;
5461 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5462 The initialized data segment is read-only. */
5463 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5464 bcopy (type
, p
, sizeof *p
);
5465 p
->next
= image_types
;
5467 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5471 /* Look up image type SYMBOL, and return a pointer to its image_type
5472 structure. Value is null if SYMBOL is not a known image type. */
5474 static INLINE
struct image_type
*
5475 lookup_image_type (symbol
)
5478 struct image_type
*type
;
5480 for (type
= image_types
; type
; type
= type
->next
)
5481 if (EQ (symbol
, *type
->type
))
5488 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5489 valid image specification is a list whose car is the symbol
5490 `image', and whose rest is a property list. The property list must
5491 contain a value for key `:type'. That value must be the name of a
5492 supported image type. The rest of the property list depends on the
5496 valid_image_p (object
)
5501 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5503 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5504 struct image_type
*type
= lookup_image_type (symbol
);
5507 valid_p
= type
->valid_p (object
);
5514 /* Log error message with format string FORMAT and argument ARG.
5515 Signaling an error, e.g. when an image cannot be loaded, is not a
5516 good idea because this would interrupt redisplay, and the error
5517 message display would lead to another redisplay. This function
5518 therefore simply displays a message. */
5521 image_error (format
, arg1
, arg2
)
5523 Lisp_Object arg1
, arg2
;
5525 add_to_log (format
, arg1
, arg2
);
5530 /***********************************************************************
5531 Image specifications
5532 ***********************************************************************/
5534 enum image_value_type
5536 IMAGE_DONT_CHECK_VALUE_TYPE
,
5539 IMAGE_POSITIVE_INTEGER_VALUE
,
5540 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5541 IMAGE_INTEGER_VALUE
,
5542 IMAGE_FUNCTION_VALUE
,
5547 /* Structure used when parsing image specifications. */
5549 struct image_keyword
5551 /* Name of keyword. */
5554 /* The type of value allowed. */
5555 enum image_value_type type
;
5557 /* Non-zero means key must be present. */
5560 /* Used to recognize duplicate keywords in a property list. */
5563 /* The value that was found. */
5568 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5570 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5573 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5574 has the format (image KEYWORD VALUE ...). One of the keyword/
5575 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5576 image_keywords structures of size NKEYWORDS describing other
5577 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5580 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5582 struct image_keyword
*keywords
;
5589 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5592 plist
= XCDR (spec
);
5593 while (CONSP (plist
))
5595 Lisp_Object key
, value
;
5597 /* First element of a pair must be a symbol. */
5599 plist
= XCDR (plist
);
5603 /* There must follow a value. */
5606 value
= XCAR (plist
);
5607 plist
= XCDR (plist
);
5609 /* Find key in KEYWORDS. Error if not found. */
5610 for (i
= 0; i
< nkeywords
; ++i
)
5611 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5617 /* Record that we recognized the keyword. If a keywords
5618 was found more than once, it's an error. */
5619 keywords
[i
].value
= value
;
5620 ++keywords
[i
].count
;
5622 if (keywords
[i
].count
> 1)
5625 /* Check type of value against allowed type. */
5626 switch (keywords
[i
].type
)
5628 case IMAGE_STRING_VALUE
:
5629 if (!STRINGP (value
))
5633 case IMAGE_SYMBOL_VALUE
:
5634 if (!SYMBOLP (value
))
5638 case IMAGE_POSITIVE_INTEGER_VALUE
:
5639 if (!INTEGERP (value
) || XINT (value
) <= 0)
5643 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5644 if (!INTEGERP (value
) || XINT (value
) < 0)
5648 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5651 case IMAGE_FUNCTION_VALUE
:
5652 value
= indirect_function (value
);
5654 || COMPILEDP (value
)
5655 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5659 case IMAGE_NUMBER_VALUE
:
5660 if (!INTEGERP (value
) && !FLOATP (value
))
5664 case IMAGE_INTEGER_VALUE
:
5665 if (!INTEGERP (value
))
5669 case IMAGE_BOOL_VALUE
:
5670 if (!NILP (value
) && !EQ (value
, Qt
))
5679 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5683 /* Check that all mandatory fields are present. */
5684 for (i
= 0; i
< nkeywords
; ++i
)
5685 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5688 return NILP (plist
);
5692 /* Return the value of KEY in image specification SPEC. Value is nil
5693 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5694 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5697 image_spec_value (spec
, key
, found
)
5698 Lisp_Object spec
, key
;
5703 xassert (valid_image_p (spec
));
5705 for (tail
= XCDR (spec
);
5706 CONSP (tail
) && CONSP (XCDR (tail
));
5707 tail
= XCDR (XCDR (tail
)))
5709 if (EQ (XCAR (tail
), key
))
5713 return XCAR (XCDR (tail
));
5725 /***********************************************************************
5726 Image type independent image structures
5727 ***********************************************************************/
5729 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5730 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5733 /* Allocate and return a new image structure for image specification
5734 SPEC. SPEC has a hash value of HASH. */
5736 static struct image
*
5737 make_image (spec
, hash
)
5741 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5743 xassert (valid_image_p (spec
));
5744 bzero (img
, sizeof *img
);
5745 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5746 xassert (img
->type
!= NULL
);
5748 img
->data
.lisp_val
= Qnil
;
5749 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5755 /* Free image IMG which was used on frame F, including its resources. */
5764 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5766 /* Remove IMG from the hash table of its cache. */
5768 img
->prev
->next
= img
->next
;
5770 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5773 img
->next
->prev
= img
->prev
;
5775 c
->images
[img
->id
] = NULL
;
5777 /* Free resources, then free IMG. */
5778 img
->type
->free (f
, img
);
5784 /* Prepare image IMG for display on frame F. Must be called before
5785 drawing an image. */
5788 prepare_image_for_display (f
, img
)
5794 /* We're about to display IMG, so set its timestamp to `now'. */
5796 img
->timestamp
= EMACS_SECS (t
);
5798 /* If IMG doesn't have a pixmap yet, load it now, using the image
5799 type dependent loader function. */
5800 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5801 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5806 /***********************************************************************
5807 Helper functions for X image types
5808 ***********************************************************************/
5810 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5811 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5813 Lisp_Object color_name
,
5814 unsigned long dflt
));
5816 /* Free X resources of image IMG which is used on frame F. */
5819 x_clear_image (f
, img
)
5826 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5833 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5835 /* If display has an immutable color map, freeing colors is not
5836 necessary and some servers don't allow it. So don't do it. */
5837 if (class != StaticColor
5838 && class != StaticGray
5839 && class != TrueColor
)
5843 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5844 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5849 xfree (img
->colors
);
5856 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5857 cannot be allocated, use DFLT. Add a newly allocated color to
5858 IMG->colors, so that it can be freed again. Value is the pixel
5861 static unsigned long
5862 x_alloc_image_color (f
, img
, color_name
, dflt
)
5865 Lisp_Object color_name
;
5869 unsigned long result
;
5871 xassert (STRINGP (color_name
));
5873 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5875 /* This isn't called frequently so we get away with simply
5876 reallocating the color vector to the needed size, here. */
5879 (unsigned long *) xrealloc (img
->colors
,
5880 img
->ncolors
* sizeof *img
->colors
);
5881 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5882 result
= color
.pixel
;
5892 /***********************************************************************
5894 ***********************************************************************/
5896 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5899 /* Return a new, initialized image cache that is allocated from the
5900 heap. Call free_image_cache to free an image cache. */
5902 struct image_cache
*
5905 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5908 bzero (c
, sizeof *c
);
5910 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5911 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5912 c
->buckets
= (struct image
**) xmalloc (size
);
5913 bzero (c
->buckets
, size
);
5918 /* Free image cache of frame F. Be aware that X frames share images
5922 free_image_cache (f
)
5925 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5930 /* Cache should not be referenced by any frame when freed. */
5931 xassert (c
->refcount
== 0);
5933 for (i
= 0; i
< c
->used
; ++i
)
5934 free_image (f
, c
->images
[i
]);
5938 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5943 /* Clear image cache of frame F. FORCE_P non-zero means free all
5944 images. FORCE_P zero means clear only images that haven't been
5945 displayed for some time. Should be called from time to time to
5946 reduce the number of loaded images. If image-eviction-seconds is
5947 non-nil, this frees images in the cache which weren't displayed for
5948 at least that many seconds. */
5951 clear_image_cache (f
, force_p
)
5955 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5957 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5961 int i
, any_freed_p
= 0;
5964 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5966 for (i
= 0; i
< c
->used
; ++i
)
5968 struct image
*img
= c
->images
[i
];
5971 || (img
->timestamp
> old
)))
5973 free_image (f
, img
);
5978 /* We may be clearing the image cache because, for example,
5979 Emacs was iconified for a longer period of time. In that
5980 case, current matrices may still contain references to
5981 images freed above. So, clear these matrices. */
5984 clear_current_matrices (f
);
5985 ++windows_or_buffers_changed
;
5991 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5993 "Clear the image cache of FRAME.\n\
5994 FRAME nil or omitted means use the selected frame.\n\
5995 FRAME t means clear the image caches of all frames.")
6003 FOR_EACH_FRAME (tail
, frame
)
6004 if (FRAME_X_P (XFRAME (frame
)))
6005 clear_image_cache (XFRAME (frame
), 1);
6008 clear_image_cache (check_x_frame (frame
), 1);
6014 /* Return the id of image with Lisp specification SPEC on frame F.
6015 SPEC must be a valid Lisp image specification (see valid_image_p). */
6018 lookup_image (f
, spec
)
6022 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6026 struct gcpro gcpro1
;
6029 /* F must be a window-system frame, and SPEC must be a valid image
6031 xassert (FRAME_WINDOW_P (f
));
6032 xassert (valid_image_p (spec
));
6036 /* Look up SPEC in the hash table of the image cache. */
6037 hash
= sxhash (spec
, 0);
6038 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6040 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6041 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6044 /* If not found, create a new image and cache it. */
6047 img
= make_image (spec
, hash
);
6048 cache_image (f
, img
);
6049 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6050 xassert (!interrupt_input_blocked
);
6052 /* If we can't load the image, and we don't have a width and
6053 height, use some arbitrary width and height so that we can
6054 draw a rectangle for it. */
6055 if (img
->load_failed_p
)
6059 value
= image_spec_value (spec
, QCwidth
, NULL
);
6060 img
->width
= (INTEGERP (value
)
6061 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6062 value
= image_spec_value (spec
, QCheight
, NULL
);
6063 img
->height
= (INTEGERP (value
)
6064 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6068 /* Handle image type independent image attributes
6069 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6070 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6073 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6074 if (INTEGERP (ascent
))
6075 img
->ascent
= XFASTINT (ascent
);
6077 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6078 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6079 img
->margin
= XFASTINT (margin
);
6081 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6082 if (INTEGERP (relief
))
6084 img
->relief
= XINT (relief
);
6085 img
->margin
+= abs (img
->relief
);
6088 /* Should we apply a Laplace edge-detection algorithm? */
6089 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6090 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6093 /* Should we built a mask heuristically? */
6094 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6095 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6097 file
= image_spec_value (spec
, QCfile
, NULL
);
6098 x_build_heuristic_mask (f
, file
, img
, heuristic_mask
);
6103 /* We're using IMG, so set its timestamp to `now'. */
6104 EMACS_GET_TIME (now
);
6105 img
->timestamp
= EMACS_SECS (now
);
6109 /* Value is the image id. */
6114 /* Cache image IMG in the image cache of frame F. */
6117 cache_image (f
, img
)
6121 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6124 /* Find a free slot in c->images. */
6125 for (i
= 0; i
< c
->used
; ++i
)
6126 if (c
->images
[i
] == NULL
)
6129 /* If no free slot found, maybe enlarge c->images. */
6130 if (i
== c
->used
&& c
->used
== c
->size
)
6133 c
->images
= (struct image
**) xrealloc (c
->images
,
6134 c
->size
* sizeof *c
->images
);
6137 /* Add IMG to c->images, and assign IMG an id. */
6143 /* Add IMG to the cache's hash table. */
6144 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6145 img
->next
= c
->buckets
[i
];
6147 img
->next
->prev
= img
;
6149 c
->buckets
[i
] = img
;
6153 /* Call FN on every image in the image cache of frame F. Used to mark
6154 Lisp Objects in the image cache. */
6157 forall_images_in_image_cache (f
, fn
)
6159 void (*fn
) P_ ((struct image
*img
));
6161 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6163 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6167 for (i
= 0; i
< c
->used
; ++i
)
6176 /***********************************************************************
6178 ***********************************************************************/
6180 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, Lisp_Object
,
6181 int, int, int, XImage
**,
6183 static void x_destroy_x_image
P_ ((XImage
*));
6184 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6187 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6188 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6189 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6190 via xmalloc. Print error messages via image_error if an error
6191 occurs. FILE is the name of an image file being processed, for
6192 error messages. Value is non-zero if successful. */
6195 x_create_x_image_and_pixmap (f
, file
, width
, height
, depth
, ximg
, pixmap
)
6198 int width
, height
, depth
;
6202 Display
*display
= FRAME_X_DISPLAY (f
);
6203 Screen
*screen
= FRAME_X_SCREEN (f
);
6204 Window window
= FRAME_X_WINDOW (f
);
6206 xassert (interrupt_input_blocked
);
6209 depth
= DefaultDepthOfScreen (screen
);
6210 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6211 depth
, ZPixmap
, 0, NULL
, width
, height
,
6212 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6215 image_error ("Unable to allocate X image for %s", file
, Qnil
);
6219 /* Allocate image raster. */
6220 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6222 /* Allocate a pixmap of the same size. */
6223 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6226 x_destroy_x_image (*ximg
);
6228 image_error ("Unable to create pixmap for `%s'", file
, Qnil
);
6236 /* Destroy XImage XIMG. Free XIMG->data. */
6239 x_destroy_x_image (ximg
)
6242 xassert (interrupt_input_blocked
);
6247 XDestroyImage (ximg
);
6252 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6253 are width and height of both the image and pixmap. */
6256 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6263 xassert (interrupt_input_blocked
);
6264 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6265 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6266 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6271 /***********************************************************************
6273 ***********************************************************************/
6275 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6277 /* Find image file FILE. Look in data-directory, then
6278 x-bitmap-file-path. Value is the full name of the file found, or
6279 nil if not found. */
6282 x_find_image_file (file
)
6285 Lisp_Object file_found
, search_path
;
6286 struct gcpro gcpro1
, gcpro2
;
6290 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6291 GCPRO2 (file_found
, search_path
);
6293 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6294 fd
= openp (search_path
, file
, "", &file_found
, 0);
6307 /***********************************************************************
6309 ***********************************************************************/
6311 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6312 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6314 static int xbm_image_p
P_ ((Lisp_Object object
));
6315 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6319 /* Indices of image specification fields in xbm_format, below. */
6321 enum xbm_keyword_index
6338 /* Vector of image_keyword structures describing the format
6339 of valid XBM image specifications. */
6341 static struct image_keyword xbm_format
[XBM_LAST
] =
6343 {":type", IMAGE_SYMBOL_VALUE
, 1},
6344 {":file", IMAGE_STRING_VALUE
, 0},
6345 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6346 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6347 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6348 {":foreground", IMAGE_STRING_VALUE
, 0},
6349 {":background", IMAGE_STRING_VALUE
, 0},
6350 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6351 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6352 {":relief", IMAGE_INTEGER_VALUE
, 0},
6353 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6354 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6357 /* Structure describing the image type XBM. */
6359 static struct image_type xbm_type
=
6368 /* Tokens returned from xbm_scan. */
6377 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6378 A valid specification is a list starting with the symbol `image'
6379 The rest of the list is a property list which must contain an
6382 If the specification specifies a file to load, it must contain
6383 an entry `:file FILENAME' where FILENAME is a string.
6385 If the specification is for a bitmap loaded from memory it must
6386 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6387 WIDTH and HEIGHT are integers > 0. DATA may be:
6389 1. a string large enough to hold the bitmap data, i.e. it must
6390 have a size >= (WIDTH + 7) / 8 * HEIGHT
6392 2. a bool-vector of size >= WIDTH * HEIGHT
6394 3. a vector of strings or bool-vectors, one for each line of the
6397 Both the file and data forms may contain the additional entries
6398 `:background COLOR' and `:foreground COLOR'. If not present,
6399 foreground and background of the frame on which the image is
6400 displayed, is used. */
6403 xbm_image_p (object
)
6406 struct image_keyword kw
[XBM_LAST
];
6408 bcopy (xbm_format
, kw
, sizeof kw
);
6409 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6412 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6414 if (kw
[XBM_FILE
].count
)
6416 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6424 /* Entries for `:width', `:height' and `:data' must be present. */
6425 if (!kw
[XBM_WIDTH
].count
6426 || !kw
[XBM_HEIGHT
].count
6427 || !kw
[XBM_DATA
].count
)
6430 data
= kw
[XBM_DATA
].value
;
6431 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6432 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6434 /* Check type of data, and width and height against contents of
6440 /* Number of elements of the vector must be >= height. */
6441 if (XVECTOR (data
)->size
< height
)
6444 /* Each string or bool-vector in data must be large enough
6445 for one line of the image. */
6446 for (i
= 0; i
< height
; ++i
)
6448 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6452 if (XSTRING (elt
)->size
6453 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6456 else if (BOOL_VECTOR_P (elt
))
6458 if (XBOOL_VECTOR (elt
)->size
< width
)
6465 else if (STRINGP (data
))
6467 if (XSTRING (data
)->size
6468 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6471 else if (BOOL_VECTOR_P (data
))
6473 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6480 /* Baseline must be a value between 0 and 100 (a percentage). */
6481 if (kw
[XBM_ASCENT
].count
6482 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6489 /* Scan a bitmap file. FP is the stream to read from. Value is
6490 either an enumerator from enum xbm_token, or a character for a
6491 single-character token, or 0 at end of file. If scanning an
6492 identifier, store the lexeme of the identifier in SVAL. If
6493 scanning a number, store its value in *IVAL. */
6496 xbm_scan (fp
, sval
, ival
)
6503 /* Skip white space. */
6504 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6509 else if (isdigit (c
))
6511 int value
= 0, digit
;
6516 if (c
== 'x' || c
== 'X')
6518 while ((c
= fgetc (fp
)) != EOF
)
6522 else if (c
>= 'a' && c
<= 'f')
6523 digit
= c
- 'a' + 10;
6524 else if (c
>= 'A' && c
<= 'F')
6525 digit
= c
- 'A' + 10;
6528 value
= 16 * value
+ digit
;
6531 else if (isdigit (c
))
6534 while ((c
= fgetc (fp
)) != EOF
6536 value
= 8 * value
+ c
- '0';
6542 while ((c
= fgetc (fp
)) != EOF
6544 value
= 10 * value
+ c
- '0';
6552 else if (isalpha (c
) || c
== '_')
6555 while ((c
= fgetc (fp
)) != EOF
6556 && (isalnum (c
) || c
== '_'))
6568 /* Replacement for XReadBitmapFileData which isn't available under old
6569 X versions. FILE is the name of the bitmap file to read. Set
6570 *WIDTH and *HEIGHT to the width and height of the image. Return in
6571 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6575 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6577 int *width
, *height
;
6578 unsigned char **data
;
6581 char buffer
[BUFSIZ
];
6584 int bytes_per_line
, i
, nbytes
;
6590 LA1 = xbm_scan (fp, buffer, &value)
6592 #define expect(TOKEN) \
6593 if (LA1 != (TOKEN)) \
6598 #define expect_ident(IDENT) \
6599 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6604 fp
= fopen (file
, "r");
6608 *width
= *height
= -1;
6610 LA1
= xbm_scan (fp
, buffer
, &value
);
6612 /* Parse defines for width, height and hot-spots. */
6616 expect_ident ("define");
6617 expect (XBM_TK_IDENT
);
6619 if (LA1
== XBM_TK_NUMBER
);
6621 char *p
= strrchr (buffer
, '_');
6622 p
= p
? p
+ 1 : buffer
;
6623 if (strcmp (p
, "width") == 0)
6625 else if (strcmp (p
, "height") == 0)
6628 expect (XBM_TK_NUMBER
);
6631 if (*width
< 0 || *height
< 0)
6634 /* Parse bits. Must start with `static'. */
6635 expect_ident ("static");
6636 if (LA1
== XBM_TK_IDENT
)
6638 if (strcmp (buffer
, "unsigned") == 0)
6641 expect_ident ("char");
6643 else if (strcmp (buffer
, "short") == 0)
6647 if (*width
% 16 && *width
% 16 < 9)
6650 else if (strcmp (buffer
, "char") == 0)
6658 expect (XBM_TK_IDENT
);
6664 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6665 nbytes
= bytes_per_line
* *height
;
6666 p
= *data
= (char *) xmalloc (nbytes
);
6671 for (i
= 0; i
< nbytes
; i
+= 2)
6674 expect (XBM_TK_NUMBER
);
6677 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6680 if (LA1
== ',' || LA1
== '}')
6688 for (i
= 0; i
< nbytes
; ++i
)
6691 expect (XBM_TK_NUMBER
);
6695 if (LA1
== ',' || LA1
== '}')
6721 /* Load XBM image IMG which will be displayed on frame F from file
6722 SPECIFIED_FILE. Value is non-zero if successful. */
6725 xbm_load_image_from_file (f
, img
, specified_file
)
6728 Lisp_Object specified_file
;
6731 unsigned char *data
;
6734 struct gcpro gcpro1
;
6736 xassert (STRINGP (specified_file
));
6740 file
= x_find_image_file (specified_file
);
6741 if (!STRINGP (file
))
6743 image_error ("Cannot find image file %s", specified_file
, Qnil
);
6748 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6749 &img
->height
, &data
);
6752 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6753 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6754 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6757 xassert (img
->width
> 0 && img
->height
> 0);
6759 /* Get foreground and background colors, maybe allocate colors. */
6760 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6762 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6764 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6766 background
= x_alloc_image_color (f
, img
, value
, background
);
6770 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6773 img
->width
, img
->height
,
6774 foreground
, background
,
6778 if (img
->pixmap
== 0)
6780 x_clear_image (f
, img
);
6781 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6789 image_error ("Error loading XBM image %s", img
->spec
, Qnil
);
6796 /* Fill image IMG which is used on frame F with pixmap data. Value is
6797 non-zero if successful. */
6805 Lisp_Object file_name
;
6807 xassert (xbm_image_p (img
->spec
));
6809 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6810 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6811 if (STRINGP (file_name
))
6812 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6815 struct image_keyword fmt
[XBM_LAST
];
6818 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6819 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6823 /* Parse the list specification. */
6824 bcopy (xbm_format
, fmt
, sizeof fmt
);
6825 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6828 /* Get specified width, and height. */
6829 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6830 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6831 xassert (img
->width
> 0 && img
->height
> 0);
6835 if (fmt
[XBM_ASCENT
].count
)
6836 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6838 /* Get foreground and background colors, maybe allocate colors. */
6839 if (fmt
[XBM_FOREGROUND
].count
)
6840 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6842 if (fmt
[XBM_BACKGROUND
].count
)
6843 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6846 /* Set bits to the bitmap image data. */
6847 data
= fmt
[XBM_DATA
].value
;
6852 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6854 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6855 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6857 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6859 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6861 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6864 else if (STRINGP (data
))
6865 bits
= XSTRING (data
)->data
;
6867 bits
= XBOOL_VECTOR (data
)->data
;
6869 /* Create the pixmap. */
6870 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6872 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6875 img
->width
, img
->height
,
6876 foreground
, background
,
6882 image_error ("Unable to create pixmap for XBM image", Qnil
, Qnil
);
6883 x_clear_image (f
, img
);
6894 /***********************************************************************
6896 ***********************************************************************/
6900 static int xpm_image_p
P_ ((Lisp_Object object
));
6901 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6902 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6904 #include "X11/xpm.h"
6906 /* The symbol `xpm' identifying XPM-format images. */
6910 /* Indices of image specification fields in xpm_format, below. */
6912 enum xpm_keyword_index
6926 /* Vector of image_keyword structures describing the format
6927 of valid XPM image specifications. */
6929 static struct image_keyword xpm_format
[XPM_LAST
] =
6931 {":type", IMAGE_SYMBOL_VALUE
, 1},
6932 {":file", IMAGE_STRING_VALUE
, 0},
6933 {":data", IMAGE_STRING_VALUE
, 0},
6934 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6935 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6936 {":relief", IMAGE_INTEGER_VALUE
, 0},
6937 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6938 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6939 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6942 /* Structure describing the image type XBM. */
6944 static struct image_type xpm_type
=
6954 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6955 for XPM images. Such a list must consist of conses whose car and
6959 xpm_valid_color_symbols_p (color_symbols
)
6960 Lisp_Object color_symbols
;
6962 while (CONSP (color_symbols
))
6964 Lisp_Object sym
= XCAR (color_symbols
);
6966 || !STRINGP (XCAR (sym
))
6967 || !STRINGP (XCDR (sym
)))
6969 color_symbols
= XCDR (color_symbols
);
6972 return NILP (color_symbols
);
6976 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6979 xpm_image_p (object
)
6982 struct image_keyword fmt
[XPM_LAST
];
6983 bcopy (xpm_format
, fmt
, sizeof fmt
);
6984 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6985 /* Either `:file' or `:data' must be present. */
6986 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6987 /* Either no `:color-symbols' or it's a list of conses
6988 whose car and cdr are strings. */
6989 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6990 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6991 && (fmt
[XPM_ASCENT
].count
== 0
6992 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6996 /* Load image IMG which will be displayed on frame F. Value is
6997 non-zero if successful. */
7005 XpmAttributes attrs
;
7006 Lisp_Object specified_file
, color_symbols
;
7008 /* Configure the XPM lib. Use the visual of frame F. Allocate
7009 close colors. Return colors allocated. */
7010 bzero (&attrs
, sizeof attrs
);
7011 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7012 attrs
.valuemask
|= XpmVisual
;
7013 attrs
.valuemask
|= XpmReturnAllocPixels
;
7014 #ifdef XpmAllocCloseColors
7015 attrs
.alloc_close_colors
= 1;
7016 attrs
.valuemask
|= XpmAllocCloseColors
;
7018 attrs
.closeness
= 600;
7019 attrs
.valuemask
|= XpmCloseness
;
7022 /* If image specification contains symbolic color definitions, add
7023 these to `attrs'. */
7024 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7025 if (CONSP (color_symbols
))
7028 XpmColorSymbol
*xpm_syms
;
7031 attrs
.valuemask
|= XpmColorSymbols
;
7033 /* Count number of symbols. */
7034 attrs
.numsymbols
= 0;
7035 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7038 /* Allocate an XpmColorSymbol array. */
7039 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7040 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7041 bzero (xpm_syms
, size
);
7042 attrs
.colorsymbols
= xpm_syms
;
7044 /* Fill the color symbol array. */
7045 for (tail
= color_symbols
, i
= 0;
7047 ++i
, tail
= XCDR (tail
))
7049 Lisp_Object name
= XCAR (XCAR (tail
));
7050 Lisp_Object color
= XCDR (XCAR (tail
));
7051 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7052 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7053 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7054 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7058 /* Create a pixmap for the image, either from a file, or from a
7059 string buffer containing data in the same format as an XPM file. */
7061 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7062 if (STRINGP (specified_file
))
7064 Lisp_Object file
= x_find_image_file (specified_file
);
7065 if (!STRINGP (file
))
7067 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7072 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7073 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7078 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7079 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7080 XSTRING (buffer
)->data
,
7081 &img
->pixmap
, &img
->mask
,
7086 if (rc
== XpmSuccess
)
7088 /* Remember allocated colors. */
7089 img
->ncolors
= attrs
.nalloc_pixels
;
7090 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7091 * sizeof *img
->colors
);
7092 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7093 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7095 img
->width
= attrs
.width
;
7096 img
->height
= attrs
.height
;
7097 xassert (img
->width
> 0 && img
->height
> 0);
7099 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7101 XpmFreeAttributes (&attrs
);
7109 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7112 case XpmFileInvalid
:
7113 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7117 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7120 case XpmColorFailed
:
7121 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7125 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7130 return rc
== XpmSuccess
;
7133 #endif /* HAVE_XPM != 0 */
7136 /***********************************************************************
7138 ***********************************************************************/
7140 /* An entry in the color table mapping an RGB color to a pixel color. */
7145 unsigned long pixel
;
7147 /* Next in color table collision list. */
7148 struct ct_color
*next
;
7151 /* The bucket vector size to use. Must be prime. */
7155 /* Value is a hash of the RGB color given by R, G, and B. */
7157 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7159 /* The color hash table. */
7161 struct ct_color
**ct_table
;
7163 /* Number of entries in the color table. */
7165 int ct_colors_allocated
;
7167 /* Function prototypes. */
7169 static void init_color_table
P_ ((void));
7170 static void free_color_table
P_ ((void));
7171 static unsigned long *colors_in_color_table
P_ ((int *n
));
7172 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7173 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7176 /* Initialize the color table. */
7181 int size
= CT_SIZE
* sizeof (*ct_table
);
7182 ct_table
= (struct ct_color
**) xmalloc (size
);
7183 bzero (ct_table
, size
);
7184 ct_colors_allocated
= 0;
7188 /* Free memory associated with the color table. */
7194 struct ct_color
*p
, *next
;
7196 for (i
= 0; i
< CT_SIZE
; ++i
)
7197 for (p
= ct_table
[i
]; p
; p
= next
)
7208 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7209 entry for that color already is in the color table, return the
7210 pixel color of that entry. Otherwise, allocate a new color for R,
7211 G, B, and make an entry in the color table. */
7213 static unsigned long
7214 lookup_rgb_color (f
, r
, g
, b
)
7218 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7219 int i
= hash
% CT_SIZE
;
7222 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7223 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7237 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7238 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7243 ++ct_colors_allocated
;
7245 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7249 p
->pixel
= color
.pixel
;
7250 p
->next
= ct_table
[i
];
7254 return FRAME_FOREGROUND_PIXEL (f
);
7261 /* Look up pixel color PIXEL which is used on frame F in the color
7262 table. If not already present, allocate it. Value is PIXEL. */
7264 static unsigned long
7265 lookup_pixel_color (f
, pixel
)
7267 unsigned long pixel
;
7269 int i
= pixel
% CT_SIZE
;
7272 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7273 if (p
->pixel
== pixel
)
7284 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7285 color
.pixel
= pixel
;
7286 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7287 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7292 ++ct_colors_allocated
;
7294 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7299 p
->next
= ct_table
[i
];
7303 return FRAME_FOREGROUND_PIXEL (f
);
7310 /* Value is a vector of all pixel colors contained in the color table,
7311 allocated via xmalloc. Set *N to the number of colors. */
7313 static unsigned long *
7314 colors_in_color_table (n
)
7319 unsigned long *colors
;
7321 if (ct_colors_allocated
== 0)
7328 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7330 *n
= ct_colors_allocated
;
7332 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7333 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7334 colors
[j
++] = p
->pixel
;
7342 /***********************************************************************
7344 ***********************************************************************/
7346 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7347 int, XImage
*, int));
7348 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7349 XColor
*, int, XImage
*, int));
7352 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7353 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7354 the width of one row in the image. */
7357 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7367 for (x
= 0; x
< width
; ++x
)
7368 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7370 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7374 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7375 containing the pixel colors to write. F is the frame we are
7379 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7388 for (x
= 0; x
< width
; ++x
)
7389 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7393 /* Transform image IMG which is used on frame F with a Laplace
7394 edge-detection algorithm. The result is an image that can be used
7395 to draw disabled buttons, for example. */
7402 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7403 XImage
*ximg
, *oimg
;
7409 int in_y
, out_y
, rc
;
7414 /* Get the X image IMG->pixmap. */
7415 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7416 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7418 /* Allocate 3 input rows, and one output row of colors. */
7419 for (i
= 0; i
< 3; ++i
)
7420 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7421 out
= (long *) alloca (img
->width
* sizeof (long));
7423 /* Create an X image for output. */
7424 rc
= x_create_x_image_and_pixmap (f
, Qnil
, img
->width
, img
->height
, 0,
7427 /* Fill first two rows. */
7428 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7429 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7432 /* Write first row, all zeros. */
7433 init_color_table ();
7434 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7435 for (x
= 0; x
< img
->width
; ++x
)
7437 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7440 for (y
= 2; y
< img
->height
; ++y
)
7443 int rowb
= (y
+ 2) % 3;
7445 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7447 for (x
= 0; x
< img
->width
- 2; ++x
)
7449 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7450 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7451 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7453 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7457 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7460 /* Write last line, all zeros. */
7461 for (x
= 0; x
< img
->width
; ++x
)
7463 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7465 /* Free the input image, and free resources of IMG. */
7466 XDestroyImage (ximg
);
7467 x_clear_image (f
, img
);
7469 /* Put the output image into pixmap, and destroy it. */
7470 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7471 x_destroy_x_image (oimg
);
7473 /* Remember new pixmap and colors in IMG. */
7474 img
->pixmap
= pixmap
;
7475 img
->colors
= colors_in_color_table (&img
->ncolors
);
7476 free_color_table ();
7482 /* Build a mask for image IMG which is used on frame F. FILE is the
7483 name of an image file, for error messages. HOW determines how to
7484 determine the background color of IMG. If it is a list '(R G B)',
7485 with R, G, and B being integers >= 0, take that as the color of the
7486 background. Otherwise, determine the background color of IMG
7487 heuristically. Value is non-zero if successful. */
7490 x_build_heuristic_mask (f
, file
, img
, how
)
7496 Display
*dpy
= FRAME_X_DISPLAY (f
);
7497 XImage
*ximg
, *mask_img
;
7498 int x
, y
, rc
, look_at_corners_p
;
7503 /* Create an image and pixmap serving as mask. */
7504 rc
= x_create_x_image_and_pixmap (f
, file
, img
->width
, img
->height
, 1,
7505 &mask_img
, &img
->mask
);
7512 /* Get the X image of IMG->pixmap. */
7513 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7516 /* Determine the background color of ximg. If HOW is `(R G B)'
7517 take that as color. Otherwise, try to determine the color
7519 look_at_corners_p
= 1;
7527 && NATNUMP (XCAR (how
)))
7529 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7533 if (i
== 3 && NILP (how
))
7535 char color_name
[30];
7536 XColor exact
, color
;
7539 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7541 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7542 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7545 look_at_corners_p
= 0;
7550 if (look_at_corners_p
)
7552 unsigned long corners
[4];
7555 /* Get the colors at the corners of ximg. */
7556 corners
[0] = XGetPixel (ximg
, 0, 0);
7557 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7558 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7559 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7561 /* Choose the most frequently found color as background. */
7562 for (i
= best_count
= 0; i
< 4; ++i
)
7566 for (j
= n
= 0; j
< 4; ++j
)
7567 if (corners
[i
] == corners
[j
])
7571 bg
= corners
[i
], best_count
= n
;
7575 /* Set all bits in mask_img to 1 whose color in ximg is different
7576 from the background color bg. */
7577 for (y
= 0; y
< img
->height
; ++y
)
7578 for (x
= 0; x
< img
->width
; ++x
)
7579 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7581 /* Put mask_img into img->mask. */
7582 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7583 x_destroy_x_image (mask_img
);
7584 XDestroyImage (ximg
);
7592 /***********************************************************************
7593 PBM (mono, gray, color)
7594 ***********************************************************************/
7596 static int pbm_image_p
P_ ((Lisp_Object object
));
7597 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7598 static int pbm_scan_number
P_ ((FILE *fp
));
7600 /* The symbol `pbm' identifying images of this type. */
7604 /* Indices of image specification fields in gs_format, below. */
7606 enum pbm_keyword_index
7618 /* Vector of image_keyword structures describing the format
7619 of valid user-defined image specifications. */
7621 static struct image_keyword pbm_format
[PBM_LAST
] =
7623 {":type", IMAGE_SYMBOL_VALUE
, 1},
7624 {":file", IMAGE_STRING_VALUE
, 1},
7625 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7626 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7627 {":relief", IMAGE_INTEGER_VALUE
, 0},
7628 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7629 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7632 /* Structure describing the image type `pbm'. */
7634 static struct image_type pbm_type
=
7644 /* Return non-zero if OBJECT is a valid PBM image specification. */
7647 pbm_image_p (object
)
7650 struct image_keyword fmt
[PBM_LAST
];
7652 bcopy (pbm_format
, fmt
, sizeof fmt
);
7654 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7655 || (fmt
[PBM_ASCENT
].count
7656 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7662 /* Scan a decimal number from PBM input file FP and return it. Value
7663 is -1 at end of file or if an error occurs. */
7666 pbm_scan_number (fp
)
7673 /* Skip white-space. */
7674 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
7679 /* Skip comment to end of line. */
7680 while ((c
= fgetc (fp
)) != EOF
&& c
!= '\n')
7683 else if (isdigit (c
))
7685 /* Read decimal number. */
7687 while ((c
= fgetc (fp
)) != EOF
&& isdigit (c
))
7688 val
= 10 * val
+ c
- '0';
7699 /* Load PBM image IMG for use on frame F. */
7709 int width
, height
, max_color_idx
= 0;
7711 Lisp_Object file
, specified_file
;
7712 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7713 struct gcpro gcpro1
;
7715 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7716 file
= x_find_image_file (specified_file
);
7718 if (!STRINGP (file
))
7720 image_error ("Cannot find image file %s", specified_file
, Qnil
);
7725 fp
= fopen (XSTRING (file
)->data
, "r");
7732 /* Read first two characters. */
7733 if (fread (magic
, sizeof *magic
, 2, fp
) != 2)
7736 image_error ("Not a PBM image file: %s", file
, Qnil
);
7744 image_error ("Not a PBM image file: %s", file
, Qnil
);
7752 raw_p
= 0, type
= PBM_MONO
;
7756 raw_p
= 0, type
= PBM_GRAY
;
7760 raw_p
= 0, type
= PBM_COLOR
;
7764 raw_p
= 1, type
= PBM_MONO
;
7768 raw_p
= 1, type
= PBM_GRAY
;
7772 raw_p
= 1, type
= PBM_COLOR
;
7777 image_error ("Not a PBM image file: %s", file
, Qnil
);
7782 /* Read width, height, maximum color-component. Characters
7783 starting with `#' up to the end of a line are ignored. */
7784 width
= pbm_scan_number (fp
);
7785 height
= pbm_scan_number (fp
);
7787 if (type
!= PBM_MONO
)
7789 max_color_idx
= pbm_scan_number (fp
);
7790 if (raw_p
&& max_color_idx
> 255)
7791 max_color_idx
= 255;
7794 if (width
< 0 || height
< 0
7795 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7803 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0,
7804 &ximg
, &img
->pixmap
))
7812 /* Initialize the color hash table. */
7813 init_color_table ();
7815 if (type
== PBM_MONO
)
7819 for (y
= 0; y
< height
; ++y
)
7820 for (x
= 0; x
< width
; ++x
)
7830 g
= pbm_scan_number (fp
);
7832 XPutPixel (ximg
, x
, y
, (g
7833 ? FRAME_FOREGROUND_PIXEL (f
)
7834 : FRAME_BACKGROUND_PIXEL (f
)));
7839 for (y
= 0; y
< height
; ++y
)
7840 for (x
= 0; x
< width
; ++x
)
7844 if (type
== PBM_GRAY
)
7845 r
= g
= b
= raw_p
? fgetc (fp
) : pbm_scan_number (fp
);
7854 r
= pbm_scan_number (fp
);
7855 g
= pbm_scan_number (fp
);
7856 b
= pbm_scan_number (fp
);
7859 if (r
< 0 || g
< 0 || b
< 0)
7864 XDestroyImage (ximg
);
7866 image_error ("Invalid pixel value in file `%s'",
7872 /* RGB values are now in the range 0..max_color_idx.
7873 Scale this to the range 0..0xffff supported by X. */
7874 r
= (double) r
* 65535 / max_color_idx
;
7875 g
= (double) g
* 65535 / max_color_idx
;
7876 b
= (double) b
* 65535 / max_color_idx
;
7877 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7883 /* Store in IMG->colors the colors allocated for the image, and
7884 free the color table. */
7885 img
->colors
= colors_in_color_table (&img
->ncolors
);
7886 free_color_table ();
7888 /* Put the image into a pixmap. */
7889 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7890 x_destroy_x_image (ximg
);
7894 img
->height
= height
;
7902 /***********************************************************************
7904 ***********************************************************************/
7910 /* Function prototypes. */
7912 static int png_image_p
P_ ((Lisp_Object object
));
7913 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7915 /* The symbol `png' identifying images of this type. */
7919 /* Indices of image specification fields in png_format, below. */
7921 enum png_keyword_index
7933 /* Vector of image_keyword structures describing the format
7934 of valid user-defined image specifications. */
7936 static struct image_keyword png_format
[PNG_LAST
] =
7938 {":type", IMAGE_SYMBOL_VALUE
, 1},
7939 {":file", IMAGE_STRING_VALUE
, 1},
7940 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7941 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7942 {":relief", IMAGE_INTEGER_VALUE
, 0},
7943 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7944 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7947 /* Structure describing the image type `png'. */
7949 static struct image_type png_type
=
7959 /* Return non-zero if OBJECT is a valid PNG image specification. */
7962 png_image_p (object
)
7965 struct image_keyword fmt
[PNG_LAST
];
7966 bcopy (png_format
, fmt
, sizeof fmt
);
7968 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
7969 || (fmt
[PNG_ASCENT
].count
7970 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
7976 /* Error and warning handlers installed when the PNG library
7980 my_png_error (png_ptr
, msg
)
7981 png_struct
*png_ptr
;
7984 xassert (png_ptr
!= NULL
);
7985 image_error ("PNG error: %s", build_string (msg
), Qnil
);
7986 longjmp (png_ptr
->jmpbuf
, 1);
7991 my_png_warning (png_ptr
, msg
)
7992 png_struct
*png_ptr
;
7995 xassert (png_ptr
!= NULL
);
7996 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8000 /* Load PNG image IMG for use on frame F. Value is non-zero if
8008 Lisp_Object file
, specified_file
;
8010 XImage
*ximg
, *mask_img
= NULL
;
8011 struct gcpro gcpro1
;
8012 png_struct
*png_ptr
= NULL
;
8013 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8016 png_byte
*pixels
= NULL
;
8017 png_byte
**rows
= NULL
;
8018 png_uint_32 width
, height
;
8019 int bit_depth
, color_type
, interlace_type
;
8021 png_uint_32 row_bytes
;
8024 double screen_gamma
, image_gamma
;
8027 /* Find out what file to load. */
8028 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8029 file
= x_find_image_file (specified_file
);
8031 if (!STRINGP (file
))
8033 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8038 /* Open the image file. */
8039 fp
= fopen (XSTRING (file
)->data
, "rb");
8042 image_error ("Cannot open image file %s", file
, Qnil
);
8048 /* Check PNG signature. */
8049 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8050 || !png_check_sig (sig
, sizeof sig
))
8052 image_error ("Not a PNG file: %s", file
, Qnil
);
8058 /* Initialize read and info structs for PNG lib. */
8059 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8060 my_png_error
, my_png_warning
);
8068 info_ptr
= png_create_info_struct (png_ptr
);
8071 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8077 end_info
= png_create_info_struct (png_ptr
);
8080 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8086 /* Set error jump-back. We come back here when the PNG library
8087 detects an error. */
8088 if (setjmp (png_ptr
->jmpbuf
))
8092 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8101 /* Read image info. */
8102 png_init_io (png_ptr
, fp
);
8103 png_set_sig_bytes (png_ptr
, sizeof sig
);
8104 png_read_info (png_ptr
, info_ptr
);
8105 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8106 &interlace_type
, NULL
, NULL
);
8108 /* If image contains simply transparency data, we prefer to
8109 construct a clipping mask. */
8110 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8115 /* This function is easier to write if we only have to handle
8116 one data format: RGB or RGBA with 8 bits per channel. Let's
8117 transform other formats into that format. */
8119 /* Strip more than 8 bits per channel. */
8120 if (bit_depth
== 16)
8121 png_set_strip_16 (png_ptr
);
8123 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8125 png_set_expand (png_ptr
);
8127 /* Convert grayscale images to RGB. */
8128 if (color_type
== PNG_COLOR_TYPE_GRAY
8129 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8130 png_set_gray_to_rgb (png_ptr
);
8132 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8133 gamma_str
= getenv ("SCREEN_GAMMA");
8134 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8136 /* Tell the PNG lib to handle gamma correction for us. */
8138 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8139 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8140 /* There is a special chunk in the image specifying the gamma. */
8141 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8144 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8145 /* Image contains gamma information. */
8146 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8148 /* Use a default of 0.5 for the image gamma. */
8149 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8151 /* Handle alpha channel by combining the image with a background
8152 color. Do this only if a real alpha channel is supplied. For
8153 simple transparency, we prefer a clipping mask. */
8156 png_color_16
*image_background
;
8158 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8159 /* Image contains a background color with which to
8160 combine the image. */
8161 png_set_background (png_ptr
, image_background
,
8162 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8165 /* Image does not contain a background color with which
8166 to combine the image data via an alpha channel. Use
8167 the frame's background instead. */
8170 png_color_16 frame_background
;
8173 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8174 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8175 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8178 bzero (&frame_background
, sizeof frame_background
);
8179 frame_background
.red
= color
.red
;
8180 frame_background
.green
= color
.green
;
8181 frame_background
.blue
= color
.blue
;
8183 png_set_background (png_ptr
, &frame_background
,
8184 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8188 /* Update info structure. */
8189 png_read_update_info (png_ptr
, info_ptr
);
8191 /* Get number of channels. Valid values are 1 for grayscale images
8192 and images with a palette, 2 for grayscale images with transparency
8193 information (alpha channel), 3 for RGB images, and 4 for RGB
8194 images with alpha channel, i.e. RGBA. If conversions above were
8195 sufficient we should only have 3 or 4 channels here. */
8196 channels
= png_get_channels (png_ptr
, info_ptr
);
8197 xassert (channels
== 3 || channels
== 4);
8199 /* Number of bytes needed for one row of the image. */
8200 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8202 /* Allocate memory for the image. */
8203 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8204 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8205 for (i
= 0; i
< height
; ++i
)
8206 rows
[i
] = pixels
+ i
* row_bytes
;
8208 /* Read the entire image. */
8209 png_read_image (png_ptr
, rows
);
8210 png_read_end (png_ptr
, info_ptr
);
8216 /* Create the X image and pixmap. */
8217 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8224 /* Create an image and pixmap serving as mask if the PNG image
8225 contains an alpha channel. */
8228 && !x_create_x_image_and_pixmap (f
, file
, width
, height
, 1,
8229 &mask_img
, &img
->mask
))
8231 x_destroy_x_image (ximg
);
8232 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8238 /* Fill the X image and mask from PNG data. */
8239 init_color_table ();
8241 for (y
= 0; y
< height
; ++y
)
8243 png_byte
*p
= rows
[y
];
8245 for (x
= 0; x
< width
; ++x
)
8252 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8254 /* An alpha channel, aka mask channel, associates variable
8255 transparency with an image. Where other image formats
8256 support binary transparency---fully transparent or fully
8257 opaque---PNG allows up to 254 levels of partial transparency.
8258 The PNG library implements partial transparency by combining
8259 the image with a specified background color.
8261 I'm not sure how to handle this here nicely: because the
8262 background on which the image is displayed may change, for
8263 real alpha channel support, it would be necessary to create
8264 a new image for each possible background.
8266 What I'm doing now is that a mask is created if we have
8267 boolean transparency information. Otherwise I'm using
8268 the frame's background color to combine the image with. */
8273 XPutPixel (mask_img
, x
, y
, *p
> 0);
8279 /* Remember colors allocated for this image. */
8280 img
->colors
= colors_in_color_table (&img
->ncolors
);
8281 free_color_table ();
8284 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8289 img
->height
= height
;
8291 /* Put the image into the pixmap, then free the X image and its buffer. */
8292 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8293 x_destroy_x_image (ximg
);
8295 /* Same for the mask. */
8298 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8299 x_destroy_x_image (mask_img
);
8307 #endif /* HAVE_PNG != 0 */
8311 /***********************************************************************
8313 ***********************************************************************/
8317 /* Work around a warning about HAVE_STDLIB_H being redefined in
8319 #ifdef HAVE_STDLIB_H
8320 #define HAVE_STDLIB_H_1
8321 #undef HAVE_STDLIB_H
8322 #endif /* HAVE_STLIB_H */
8324 #include <jpeglib.h>
8328 #ifdef HAVE_STLIB_H_1
8329 #define HAVE_STDLIB_H 1
8332 static int jpeg_image_p
P_ ((Lisp_Object object
));
8333 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8335 /* The symbol `jpeg' identifying images of this type. */
8339 /* Indices of image specification fields in gs_format, below. */
8341 enum jpeg_keyword_index
8349 JPEG_HEURISTIC_MASK
,
8353 /* Vector of image_keyword structures describing the format
8354 of valid user-defined image specifications. */
8356 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8358 {":type", IMAGE_SYMBOL_VALUE
, 1},
8359 {":file", IMAGE_STRING_VALUE
, 1},
8360 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8361 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8362 {":relief", IMAGE_INTEGER_VALUE
, 0},
8363 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8364 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8367 /* Structure describing the image type `jpeg'. */
8369 static struct image_type jpeg_type
=
8379 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8382 jpeg_image_p (object
)
8385 struct image_keyword fmt
[JPEG_LAST
];
8387 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8389 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
8390 || (fmt
[JPEG_ASCENT
].count
8391 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8396 struct my_jpeg_error_mgr
8398 struct jpeg_error_mgr pub
;
8399 jmp_buf setjmp_buffer
;
8403 my_error_exit (cinfo
)
8406 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8407 longjmp (mgr
->setjmp_buffer
, 1);
8410 /* Load image IMG for use on frame F. Patterned after example.c
8411 from the JPEG lib. */
8418 struct jpeg_decompress_struct cinfo
;
8419 struct my_jpeg_error_mgr mgr
;
8420 Lisp_Object file
, specified_file
;
8423 int row_stride
, x
, y
;
8424 XImage
*ximg
= NULL
;
8426 unsigned long *colors
;
8428 struct gcpro gcpro1
;
8430 /* Open the JPEG file. */
8431 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8432 file
= x_find_image_file (specified_file
);
8434 if (!STRINGP (file
))
8436 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8441 fp
= fopen (XSTRING (file
)->data
, "r");
8444 image_error ("Cannot open `%s'", file
, Qnil
);
8449 /* Customize libjpeg's error handling to call my_error_exit
8450 when an error is detected. This function will perform
8452 mgr
.pub
.error_exit
= my_error_exit
;
8453 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8455 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8459 /* Called from my_error_exit. Display a JPEG error. */
8460 char buffer
[JMSG_LENGTH_MAX
];
8461 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8462 image_error ("Error reading JPEG file `%s': %s", file
,
8463 build_string (buffer
));
8466 /* Close the input file and destroy the JPEG object. */
8468 jpeg_destroy_decompress (&cinfo
);
8472 /* If we already have an XImage, free that. */
8473 x_destroy_x_image (ximg
);
8475 /* Free pixmap and colors. */
8476 x_clear_image (f
, img
);
8483 /* Create the JPEG decompression object. Let it read from fp.
8484 Read the JPEG image header. */
8485 jpeg_create_decompress (&cinfo
);
8486 jpeg_stdio_src (&cinfo
, fp
);
8487 jpeg_read_header (&cinfo
, TRUE
);
8489 /* Customize decompression so that color quantization will be used.
8490 Start decompression. */
8491 cinfo
.quantize_colors
= TRUE
;
8492 jpeg_start_decompress (&cinfo
);
8493 width
= img
->width
= cinfo
.output_width
;
8494 height
= img
->height
= cinfo
.output_height
;
8498 /* Create X image and pixmap. */
8499 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8503 longjmp (mgr
.setjmp_buffer
, 2);
8506 /* Allocate colors. When color quantization is used,
8507 cinfo.actual_number_of_colors has been set with the number of
8508 colors generated, and cinfo.colormap is a two-dimensional array
8509 of color indices in the range 0..cinfo.actual_number_of_colors.
8510 No more than 255 colors will be generated. */
8514 if (cinfo
.out_color_components
> 2)
8515 ir
= 0, ig
= 1, ib
= 2;
8516 else if (cinfo
.out_color_components
> 1)
8517 ir
= 0, ig
= 1, ib
= 0;
8519 ir
= 0, ig
= 0, ib
= 0;
8521 /* Use the color table mechanism because it handles colors that
8522 cannot be allocated nicely. Such colors will be replaced with
8523 a default color, and we don't have to care about which colors
8524 can be freed safely, and which can't. */
8525 init_color_table ();
8526 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8529 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8531 /* Multiply RGB values with 255 because X expects RGB values
8532 in the range 0..0xffff. */
8533 int r
= cinfo
.colormap
[ir
][i
] << 8;
8534 int g
= cinfo
.colormap
[ig
][i
] << 8;
8535 int b
= cinfo
.colormap
[ib
][i
] << 8;
8536 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8539 /* Remember those colors actually allocated. */
8540 img
->colors
= colors_in_color_table (&img
->ncolors
);
8541 free_color_table ();
8545 row_stride
= width
* cinfo
.output_components
;
8546 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8548 for (y
= 0; y
< height
; ++y
)
8550 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8551 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8552 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8556 jpeg_finish_decompress (&cinfo
);
8557 jpeg_destroy_decompress (&cinfo
);
8560 /* Put the image into the pixmap. */
8561 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8562 x_destroy_x_image (ximg
);
8568 #endif /* HAVE_JPEG */
8572 /***********************************************************************
8574 ***********************************************************************/
8580 static int tiff_image_p
P_ ((Lisp_Object object
));
8581 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8583 /* The symbol `tiff' identifying images of this type. */
8587 /* Indices of image specification fields in tiff_format, below. */
8589 enum tiff_keyword_index
8597 TIFF_HEURISTIC_MASK
,
8601 /* Vector of image_keyword structures describing the format
8602 of valid user-defined image specifications. */
8604 static struct image_keyword tiff_format
[TIFF_LAST
] =
8606 {":type", IMAGE_SYMBOL_VALUE
, 1},
8607 {":file", IMAGE_STRING_VALUE
, 1},
8608 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8609 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8610 {":relief", IMAGE_INTEGER_VALUE
, 0},
8611 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8612 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8615 /* Structure describing the image type `tiff'. */
8617 static struct image_type tiff_type
=
8627 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8630 tiff_image_p (object
)
8633 struct image_keyword fmt
[TIFF_LAST
];
8634 bcopy (tiff_format
, fmt
, sizeof fmt
);
8636 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
8637 || (fmt
[TIFF_ASCENT
].count
8638 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8644 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8652 Lisp_Object file
, specified_file
;
8654 int width
, height
, x
, y
;
8658 struct gcpro gcpro1
;
8660 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8661 file
= x_find_image_file (specified_file
);
8663 if (!STRINGP (file
))
8665 image_error ("Cannot find image file %s", file
, Qnil
);
8670 /* Try to open the image file. */
8671 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
8674 image_error ("Cannot open `%s'", file
, Qnil
);
8679 /* Get width and height of the image, and allocate a raster buffer
8680 of width x height 32-bit values. */
8681 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
8682 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
8683 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
8685 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
8689 image_error ("Error reading `%s'", file
, Qnil
);
8697 /* Create the X image and pixmap. */
8698 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8707 /* Initialize the color table. */
8708 init_color_table ();
8710 /* Process the pixel raster. Origin is in the lower-left corner. */
8711 for (y
= 0; y
< height
; ++y
)
8713 uint32
*row
= buf
+ y
* width
;
8715 for (x
= 0; x
< width
; ++x
)
8717 uint32 abgr
= row
[x
];
8718 int r
= TIFFGetR (abgr
) << 8;
8719 int g
= TIFFGetG (abgr
) << 8;
8720 int b
= TIFFGetB (abgr
) << 8;
8721 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
8725 /* Remember the colors allocated for the image. Free the color table. */
8726 img
->colors
= colors_in_color_table (&img
->ncolors
);
8727 free_color_table ();
8729 /* Put the image into the pixmap, then free the X image and its buffer. */
8730 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8731 x_destroy_x_image (ximg
);
8736 img
->height
= height
;
8742 #endif /* HAVE_TIFF != 0 */
8746 /***********************************************************************
8748 ***********************************************************************/
8752 #include <gif_lib.h>
8754 static int gif_image_p
P_ ((Lisp_Object object
));
8755 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
8757 /* The symbol `gif' identifying images of this type. */
8761 /* Indices of image specification fields in gif_format, below. */
8763 enum gif_keyword_index
8776 /* Vector of image_keyword structures describing the format
8777 of valid user-defined image specifications. */
8779 static struct image_keyword gif_format
[GIF_LAST
] =
8781 {":type", IMAGE_SYMBOL_VALUE
, 1},
8782 {":file", IMAGE_STRING_VALUE
, 1},
8783 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8784 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8785 {":relief", IMAGE_INTEGER_VALUE
, 0},
8786 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8787 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8788 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
8791 /* Structure describing the image type `gif'. */
8793 static struct image_type gif_type
=
8803 /* Return non-zero if OBJECT is a valid GIF image specification. */
8806 gif_image_p (object
)
8809 struct image_keyword fmt
[GIF_LAST
];
8810 bcopy (gif_format
, fmt
, sizeof fmt
);
8812 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
8813 || (fmt
[GIF_ASCENT
].count
8814 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
8820 /* Load GIF image IMG for use on frame F. Value is non-zero if
8828 Lisp_Object file
, specified_file
;
8829 int rc
, width
, height
, x
, y
, i
;
8831 ColorMapObject
*gif_color_map
;
8832 unsigned long pixel_colors
[256];
8834 struct gcpro gcpro1
;
8836 int ino
, image_left
, image_top
, image_width
, image_height
;
8838 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8839 file
= x_find_image_file (specified_file
);
8841 if (!STRINGP (file
))
8843 image_error ("Cannot find image file %s", specified_file
, Qnil
);
8848 /* Open the GIF file. */
8849 gif
= DGifOpenFileName (XSTRING (file
)->data
);
8852 image_error ("Cannot open `%s'", file
, Qnil
);
8857 /* Read entire contents. */
8858 rc
= DGifSlurp (gif
);
8859 if (rc
== GIF_ERROR
)
8861 image_error ("Error reading `%s'", file
, Qnil
);
8862 DGifCloseFile (gif
);
8867 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
8868 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
8869 if (ino
>= gif
->ImageCount
)
8871 image_error ("Invalid image number `%s'", image
, Qnil
);
8872 DGifCloseFile (gif
);
8877 width
= img
->width
= gif
->SWidth
;
8878 height
= img
->height
= gif
->SHeight
;
8882 /* Create the X image and pixmap. */
8883 if (!x_create_x_image_and_pixmap (f
, file
, width
, height
, 0, &ximg
,
8887 DGifCloseFile (gif
);
8892 /* Allocate colors. */
8893 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
8895 gif_color_map
= gif
->SColorMap
;
8896 init_color_table ();
8897 bzero (pixel_colors
, sizeof pixel_colors
);
8899 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
8901 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
8902 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
8903 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
8904 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8907 img
->colors
= colors_in_color_table (&img
->ncolors
);
8908 free_color_table ();
8910 /* Clear the part of the screen image that are not covered by
8911 the image from the GIF file. Full animated GIF support
8912 requires more than can be done here (see the gif89 spec,
8913 disposal methods). Let's simply assume that the part
8914 not covered by a sub-image is in the frame's background color. */
8915 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
8916 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
8917 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
8918 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
8920 for (y
= 0; y
< image_top
; ++y
)
8921 for (x
= 0; x
< width
; ++x
)
8922 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8924 for (y
= image_top
+ image_height
; y
< height
; ++y
)
8925 for (x
= 0; x
< width
; ++x
)
8926 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8928 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
8930 for (x
= 0; x
< image_left
; ++x
)
8931 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8932 for (x
= image_left
+ image_width
; x
< width
; ++x
)
8933 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
8936 /* Read the GIF image into the X image. */
8937 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
8939 static int interlace_start
[] = {0, 4, 2, 1};
8940 static int interlace_increment
[] = {8, 8, 4, 2};
8942 int row
= interlace_start
[0];
8946 for (y
= 0; y
< image_height
; y
++)
8948 if (row
>= image_height
)
8950 row
= interlace_start
[++pass
];
8951 while (row
>= image_height
)
8952 row
= interlace_start
[++pass
];
8955 for (x
= 0; x
< image_width
; x
++)
8958 = gif
->SavedImages
[ino
].RasterBits
[(y
* image_width
) + x
];
8959 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
8963 row
+= interlace_increment
[pass
];
8968 for (y
= 0; y
< image_height
; ++y
)
8969 for (x
= 0; x
< image_width
; ++x
)
8971 unsigned i
= gif
->SavedImages
[ino
].RasterBits
[y
* image_width
+ x
];
8972 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
8976 DGifCloseFile (gif
);
8978 /* Put the image into the pixmap, then free the X image and its buffer. */
8979 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8980 x_destroy_x_image (ximg
);
8987 #endif /* HAVE_GIF != 0 */
8991 /***********************************************************************
8993 ***********************************************************************/
8995 static int gs_image_p
P_ ((Lisp_Object object
));
8996 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
8997 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
8999 /* The symbol `postscript' identifying images of this type. */
9001 Lisp_Object Qpostscript
;
9003 /* Keyword symbols. */
9005 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9007 /* Indices of image specification fields in gs_format, below. */
9009 enum gs_keyword_index
9025 /* Vector of image_keyword structures describing the format
9026 of valid user-defined image specifications. */
9028 static struct image_keyword gs_format
[GS_LAST
] =
9030 {":type", IMAGE_SYMBOL_VALUE
, 1},
9031 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9032 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9033 {":file", IMAGE_STRING_VALUE
, 1},
9034 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9035 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9036 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9037 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9038 {":relief", IMAGE_INTEGER_VALUE
, 0},
9039 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9040 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9043 /* Structure describing the image type `ghostscript'. */
9045 static struct image_type gs_type
=
9055 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9058 gs_clear_image (f
, img
)
9062 /* IMG->data.ptr_val may contain a recorded colormap. */
9063 xfree (img
->data
.ptr_val
);
9064 x_clear_image (f
, img
);
9068 /* Return non-zero if OBJECT is a valid Ghostscript image
9075 struct image_keyword fmt
[GS_LAST
];
9079 bcopy (gs_format
, fmt
, sizeof fmt
);
9081 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
9082 || (fmt
[GS_ASCENT
].count
9083 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9086 /* Bounding box must be a list or vector containing 4 integers. */
9087 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9090 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9091 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9096 else if (VECTORP (tem
))
9098 if (XVECTOR (tem
)->size
!= 4)
9100 for (i
= 0; i
< 4; ++i
)
9101 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9111 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9120 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9121 struct gcpro gcpro1
, gcpro2
;
9123 double in_width
, in_height
;
9124 Lisp_Object pixel_colors
= Qnil
;
9126 /* Compute pixel size of pixmap needed from the given size in the
9127 image specification. Sizes in the specification are in pt. 1 pt
9128 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9130 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9131 in_width
= XFASTINT (pt_width
) / 72.0;
9132 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9133 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9134 in_height
= XFASTINT (pt_height
) / 72.0;
9135 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9137 /* Create the pixmap. */
9139 xassert (img
->pixmap
== 0);
9140 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9141 img
->width
, img
->height
,
9142 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9147 image_error ("Unable to create pixmap for `%s'",
9148 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9152 /* Call the loader to fill the pixmap. It returns a process object
9153 if successful. We do not record_unwind_protect here because
9154 other places in redisplay like calling window scroll functions
9155 don't either. Let the Lisp loader use `unwind-protect' instead. */
9156 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9158 sprintf (buffer
, "%lu %lu",
9159 (unsigned long) FRAME_X_WINDOW (f
),
9160 (unsigned long) img
->pixmap
);
9161 window_and_pixmap_id
= build_string (buffer
);
9163 sprintf (buffer
, "%lu %lu",
9164 FRAME_FOREGROUND_PIXEL (f
),
9165 FRAME_BACKGROUND_PIXEL (f
));
9166 pixel_colors
= build_string (buffer
);
9168 XSETFRAME (frame
, f
);
9169 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9171 loader
= intern ("gs-load-image");
9173 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9174 make_number (img
->width
),
9175 make_number (img
->height
),
9176 window_and_pixmap_id
,
9179 return PROCESSP (img
->data
.lisp_val
);
9183 /* Kill the Ghostscript process that was started to fill PIXMAP on
9184 frame F. Called from XTread_socket when receiving an event
9185 telling Emacs that Ghostscript has finished drawing. */
9188 x_kill_gs_process (pixmap
, f
)
9192 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9196 /* Find the image containing PIXMAP. */
9197 for (i
= 0; i
< c
->used
; ++i
)
9198 if (c
->images
[i
]->pixmap
== pixmap
)
9201 /* Kill the GS process. We should have found PIXMAP in the image
9202 cache and its image should contain a process object. */
9203 xassert (i
< c
->used
);
9205 xassert (PROCESSP (img
->data
.lisp_val
));
9206 Fkill_process (img
->data
.lisp_val
, Qnil
);
9207 img
->data
.lisp_val
= Qnil
;
9209 /* On displays with a mutable colormap, figure out the colors
9210 allocated for the image by looking at the pixels of an XImage for
9212 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9213 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9219 /* Try to get an XImage for img->pixmep. */
9220 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9221 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9226 /* Initialize the color table. */
9227 init_color_table ();
9229 /* For each pixel of the image, look its color up in the
9230 color table. After having done so, the color table will
9231 contain an entry for each color used by the image. */
9232 for (y
= 0; y
< img
->height
; ++y
)
9233 for (x
= 0; x
< img
->width
; ++x
)
9235 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9236 lookup_pixel_color (f
, pixel
);
9239 /* Record colors in the image. Free color table and XImage. */
9240 img
->colors
= colors_in_color_table (&img
->ncolors
);
9241 free_color_table ();
9242 XDestroyImage (ximg
);
9244 #if 0 /* This doesn't seem to be the case. If we free the colors
9245 here, we get a BadAccess later in x_clear_image when
9246 freeing the colors. */
9247 /* We have allocated colors once, but Ghostscript has also
9248 allocated colors on behalf of us. So, to get the
9249 reference counts right, free them once. */
9252 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9253 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9254 img
->colors
, img
->ncolors
, 0);
9259 image_error ("Cannot get X image of `%s'; colors will not be freed",
9260 image_spec_value (img
->spec
, QCfile
, NULL
), Qnil
);
9268 /***********************************************************************
9270 ***********************************************************************/
9272 DEFUN ("x-change-window-property", Fx_change_window_property
,
9273 Sx_change_window_property
, 2, 3, 0,
9274 "Change window property PROP to VALUE on the X window of FRAME.\n\
9275 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9276 selected frame. Value is VALUE.")
9277 (prop
, value
, frame
)
9278 Lisp_Object frame
, prop
, value
;
9280 struct frame
*f
= check_x_frame (frame
);
9283 CHECK_STRING (prop
, 1);
9284 CHECK_STRING (value
, 2);
9287 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9288 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9289 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9290 XSTRING (value
)->data
, XSTRING (value
)->size
);
9292 /* Make sure the property is set when we return. */
9293 XFlush (FRAME_X_DISPLAY (f
));
9300 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9301 Sx_delete_window_property
, 1, 2, 0,
9302 "Remove window property PROP from X window of FRAME.\n\
9303 FRAME nil or omitted means use the selected frame. Value is PROP.")
9305 Lisp_Object prop
, frame
;
9307 struct frame
*f
= check_x_frame (frame
);
9310 CHECK_STRING (prop
, 1);
9312 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9313 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9315 /* Make sure the property is removed when we return. */
9316 XFlush (FRAME_X_DISPLAY (f
));
9323 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9325 "Value is the value of window property PROP on FRAME.\n\
9326 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9327 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9330 Lisp_Object prop
, frame
;
9332 struct frame
*f
= check_x_frame (frame
);
9335 Lisp_Object prop_value
= Qnil
;
9336 char *tmp_data
= NULL
;
9339 unsigned long actual_size
, bytes_remaining
;
9341 CHECK_STRING (prop
, 1);
9343 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9344 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9345 prop_atom
, 0, 0, False
, XA_STRING
,
9346 &actual_type
, &actual_format
, &actual_size
,
9347 &bytes_remaining
, (unsigned char **) &tmp_data
);
9350 int size
= bytes_remaining
;
9355 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9356 prop_atom
, 0, bytes_remaining
,
9358 &actual_type
, &actual_format
,
9359 &actual_size
, &bytes_remaining
,
9360 (unsigned char **) &tmp_data
);
9362 prop_value
= make_string (tmp_data
, size
);
9373 /***********************************************************************
9375 ***********************************************************************/
9377 /* The implementation partly follows a patch from
9378 F.Pierresteguy@frcl.bull.fr dated 1994. */
9380 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9381 the next X event is read and we enter XTread_socket again. Setting
9382 it to 1 inhibits busy-cursor display for direct commands. */
9384 int inhibit_busy_cursor
;
9386 /* Incremented with each call to x-display-busy-cursor.
9387 Decremented in x-undisplay-busy-cursor. */
9389 static int busy_count
;
9392 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9393 Sx_show_busy_cursor
, 0, 0, 0,
9394 "Show a busy cursor, if not already shown.\n\
9395 Each call to this function must be matched by a call to\n\
9396 `x-hide-busy-cursor' to make the busy pointer disappear again.")
9400 if (busy_count
== 1)
9402 Lisp_Object rest
, frame
;
9404 FOR_EACH_FRAME (rest
, frame
)
9405 if (FRAME_X_P (XFRAME (frame
)))
9407 struct frame
*f
= XFRAME (frame
);
9410 f
->output_data
.x
->busy_p
= 1;
9412 if (!f
->output_data
.x
->busy_window
)
9414 unsigned long mask
= CWCursor
;
9415 XSetWindowAttributes attrs
;
9417 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9419 f
->output_data
.x
->busy_window
9420 = XCreateWindow (FRAME_X_DISPLAY (f
),
9421 FRAME_OUTER_WINDOW (f
),
9422 0, 0, 32000, 32000, 0, 0,
9428 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9437 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9438 Sx_hide_busy_cursor
, 0, 1, 0,
9439 "Hide a busy-cursor.\n\
9440 A busy-cursor will actually be undisplayed when a matching\n\
9441 `x-hide-busy-cursor' is called for each `x-show-busy-cursor'\n\
9442 issued. FORCE non-nil means hide the busy-cursor forcibly,\n\
9443 not counting calls.")
9447 Lisp_Object rest
, frame
;
9449 if (busy_count
== 0)
9452 if (!NILP (force
) && busy_count
!= 0)
9456 if (busy_count
!= 0)
9459 FOR_EACH_FRAME (rest
, frame
)
9461 struct frame
*f
= XFRAME (frame
);
9464 /* Watch out for newly created frames. */
9465 && f
->output_data
.x
->busy_window
)
9469 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9470 /* Sync here because XTread_socket looks at the busy_p flag
9471 that is reset to zero below. */
9472 XSync (FRAME_X_DISPLAY (f
), False
);
9474 f
->output_data
.x
->busy_p
= 0;
9483 /***********************************************************************
9485 ***********************************************************************/
9487 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9490 /* The frame of a currently visible tooltip, or null. */
9492 struct frame
*tip_frame
;
9494 /* If non-nil, a timer started that hides the last tooltip when it
9497 Lisp_Object tip_timer
;
9500 /* Create a frame for a tooltip on the display described by DPYINFO.
9501 PARMS is a list of frame parameters. Value is the frame. */
9504 x_create_tip_frame (dpyinfo
, parms
)
9505 struct x_display_info
*dpyinfo
;
9509 Lisp_Object frame
, tem
;
9511 long window_prompting
= 0;
9513 int count
= specpdl_ptr
- specpdl
;
9514 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9519 /* Use this general default value to start with until we know if
9520 this frame has a specified name. */
9521 Vx_resource_name
= Vinvocation_name
;
9524 kb
= dpyinfo
->kboard
;
9526 kb
= &the_only_kboard
;
9529 /* Get the name of the frame to use for resource lookup. */
9530 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9532 && !EQ (name
, Qunbound
)
9534 error ("Invalid frame name--not a string or nil");
9535 Vx_resource_name
= name
;
9538 GCPRO3 (parms
, name
, frame
);
9539 tip_frame
= f
= make_frame (1);
9540 XSETFRAME (frame
, f
);
9541 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9543 f
->output_method
= output_x_window
;
9544 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9545 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9546 f
->output_data
.x
->icon_bitmap
= -1;
9547 f
->output_data
.x
->fontset
= -1;
9548 f
->icon_name
= Qnil
;
9549 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9551 FRAME_KBOARD (f
) = kb
;
9553 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9554 f
->output_data
.x
->explicit_parent
= 0;
9556 /* Set the name; the functions to which we pass f expect the name to
9558 if (EQ (name
, Qunbound
) || NILP (name
))
9560 f
->name
= build_string (dpyinfo
->x_id_name
);
9561 f
->explicit_name
= 0;
9566 f
->explicit_name
= 1;
9567 /* use the frame's title when getting resources for this frame. */
9568 specbind (Qx_resource_name
, name
);
9571 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9572 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9573 fs_register_fontset (f
, XCAR (tem
));
9575 /* Extract the window parameters from the supplied values
9576 that are needed to determine window geometry. */
9580 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9583 /* First, try whatever font the caller has specified. */
9586 tem
= Fquery_fontset (font
, Qnil
);
9588 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
9590 font
= x_new_font (f
, XSTRING (font
)->data
);
9593 /* Try out a font which we hope has bold and italic variations. */
9594 if (!STRINGP (font
))
9595 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9596 if (!STRINGP (font
))
9597 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9598 if (! STRINGP (font
))
9599 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9600 if (! STRINGP (font
))
9601 /* This was formerly the first thing tried, but it finds too many fonts
9602 and takes too long. */
9603 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9604 /* If those didn't work, look for something which will at least work. */
9605 if (! STRINGP (font
))
9606 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9608 if (! STRINGP (font
))
9609 font
= build_string ("fixed");
9611 x_default_parameter (f
, parms
, Qfont
, font
,
9612 "font", "Font", RES_TYPE_STRING
);
9615 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
9616 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
9618 /* This defaults to 2 in order to match xterm. We recognize either
9619 internalBorderWidth or internalBorder (which is what xterm calls
9621 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9625 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
9626 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
9627 if (! EQ (value
, Qunbound
))
9628 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
9632 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
9633 "internalBorderWidth", "internalBorderWidth",
9636 /* Also do the stuff which must be set before the window exists. */
9637 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
9638 "foreground", "Foreground", RES_TYPE_STRING
);
9639 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
9640 "background", "Background", RES_TYPE_STRING
);
9641 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
9642 "pointerColor", "Foreground", RES_TYPE_STRING
);
9643 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
9644 "cursorColor", "Foreground", RES_TYPE_STRING
);
9645 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
9646 "borderColor", "BorderColor", RES_TYPE_STRING
);
9648 /* Init faces before x_default_parameter is called for scroll-bar
9649 parameters because that function calls x_set_scroll_bar_width,
9650 which calls change_frame_size, which calls Fset_window_buffer,
9651 which runs hooks, which call Fvertical_motion. At the end, we
9652 end up in init_iterator with a null face cache, which should not
9654 init_frame_faces (f
);
9656 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9657 window_prompting
= x_figure_window_size (f
, parms
);
9659 if (window_prompting
& XNegative
)
9661 if (window_prompting
& YNegative
)
9662 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
9664 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
9668 if (window_prompting
& YNegative
)
9669 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
9671 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
9674 f
->output_data
.x
->size_hint_flags
= window_prompting
;
9676 XSetWindowAttributes attrs
;
9680 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
9681 /* Window managers looks at the override-redirect flag to
9682 determine whether or net to give windows a decoration (Xlib
9684 attrs
.override_redirect
= True
;
9685 attrs
.save_under
= True
;
9686 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
9687 /* Arrange for getting MapNotify and UnmapNotify events. */
9688 attrs
.event_mask
= StructureNotifyMask
;
9690 = FRAME_X_WINDOW (f
)
9691 = XCreateWindow (FRAME_X_DISPLAY (f
),
9692 FRAME_X_DISPLAY_INFO (f
)->root_window
,
9693 /* x, y, width, height */
9697 CopyFromParent
, InputOutput
, CopyFromParent
,
9704 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
9705 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9706 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
9707 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
9708 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
9709 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
9711 /* Dimensions, especially f->height, must be done via change_frame_size.
9712 Change will not be effected unless different from the current
9717 SET_FRAME_WIDTH (f
, 0);
9718 change_frame_size (f
, height
, width
, 1, 0, 0);
9724 /* It is now ok to make the frame official even if we get an error
9725 below. And the frame needs to be on Vframe_list or making it
9726 visible won't work. */
9727 Vframe_list
= Fcons (frame
, Vframe_list
);
9729 /* Now that the frame is official, it counts as a reference to
9731 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
9733 return unbind_to (count
, frame
);
9737 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
9738 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
9739 A tooltip window is a small X window displaying STRING at\n\
9740 the current mouse position.\n\
9741 FRAME nil or omitted means use the selected frame.\n\
9742 PARMS is an optional list of frame parameters which can be\n\
9743 used to change the tooltip's appearance.\n\
9744 Automatically hide the tooltip after TIMEOUT seconds.\n\
9745 TIMEOUT nil means use the default timeout of 5 seconds.")
9746 (string
, frame
, parms
, timeout
)
9747 Lisp_Object string
, frame
, parms
, timeout
;
9753 struct buffer
*old_buffer
;
9754 struct text_pos pos
;
9755 int i
, width
, height
;
9756 int root_x
, root_y
, win_x
, win_y
;
9758 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9759 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
9760 int count
= specpdl_ptr
- specpdl
;
9762 specbind (Qinhibit_redisplay
, Qt
);
9764 GCPRO3 (string
, parms
, frame
);
9766 CHECK_STRING (string
, 0);
9767 f
= check_x_frame (frame
);
9769 timeout
= make_number (5);
9771 CHECK_NATNUM (timeout
, 2);
9773 /* Hide a previous tip, if any. */
9776 /* Add default values to frame parameters. */
9777 if (NILP (Fassq (Qname
, parms
)))
9778 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
9779 if (NILP (Fassq (Qinternal_border_width
, parms
)))
9780 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
9781 if (NILP (Fassq (Qborder_width
, parms
)))
9782 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
9783 if (NILP (Fassq (Qborder_color
, parms
)))
9784 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
9785 if (NILP (Fassq (Qbackground_color
, parms
)))
9786 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
9789 /* Create a frame for the tooltip, and record it in the global
9790 variable tip_frame. */
9791 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
9792 tip_frame
= f
= XFRAME (frame
);
9794 /* Set up the frame's root window. Currently we use a size of 80
9795 columns x 40 lines. If someone wants to show a larger tip, he
9796 will loose. I don't think this is a realistic case. */
9797 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
9798 w
->left
= w
->top
= make_number (0);
9802 w
->pseudo_window_p
= 1;
9804 /* Display the tooltip text in a temporary buffer. */
9805 buffer
= Fget_buffer_create (build_string (" *tip*"));
9806 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
9807 old_buffer
= current_buffer
;
9808 set_buffer_internal_1 (XBUFFER (buffer
));
9810 Finsert (make_number (1), &string
);
9811 clear_glyph_matrix (w
->desired_matrix
);
9812 clear_glyph_matrix (w
->current_matrix
);
9813 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
9814 try_window (FRAME_ROOT_WINDOW (f
), pos
);
9816 /* Compute width and height of the tooltip. */
9818 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
9820 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
9824 /* Stop at the first empty row at the end. */
9825 if (!row
->enabled_p
|| !row
->displays_text_p
)
9828 /* Let the row go over the full width of the frame. */
9829 row
->full_width_p
= 1;
9831 /* There's a glyph at the end of rows that is use to place
9832 the cursor there. Don't include the width of this glyph. */
9833 if (row
->used
[TEXT_AREA
])
9835 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
9836 row_width
= row
->pixel_width
- last
->pixel_width
;
9839 row_width
= row
->pixel_width
;
9841 height
+= row
->height
;
9842 width
= max (width
, row_width
);
9845 /* Add the frame's internal border to the width and height the X
9846 window should have. */
9847 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9848 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
9850 /* Move the tooltip window where the mouse pointer is. Resize and
9853 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
9854 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
9855 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9856 root_x
+ 5, root_y
- height
- 5, width
, height
);
9857 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
9860 /* Draw into the window. */
9861 w
->must_be_updated_p
= 1;
9862 update_single_window (w
, 1);
9864 /* Restore original current buffer. */
9865 set_buffer_internal_1 (old_buffer
);
9866 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
9868 /* Let the tip disappear after timeout seconds. */
9869 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
9870 intern ("x-hide-tip"));
9872 return unbind_to (count
, Qnil
);
9876 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
9877 "Hide the current tooltip window, if there is any.\n\
9878 Value is t is tooltip was open, nil otherwise.")
9881 int count
= specpdl_ptr
- specpdl
;
9884 specbind (Qinhibit_redisplay
, Qt
);
9886 if (!NILP (tip_timer
))
9888 call1 (intern ("cancel-timer"), tip_timer
);
9896 XSETFRAME (frame
, tip_frame
);
9897 Fdelete_frame (frame
, Qt
);
9902 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
9907 /***********************************************************************
9908 File selection dialog
9909 ***********************************************************************/
9913 /* Callback for "OK" and "Cancel" on file selection dialog. */
9916 file_dialog_cb (widget
, client_data
, call_data
)
9918 XtPointer call_data
, client_data
;
9920 int *result
= (int *) client_data
;
9921 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
9922 *result
= cb
->reason
;
9926 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
9927 "Read file name, prompting with PROMPT in directory DIR.\n\
9928 Use a file selection dialog.\n\
9929 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9930 specified. Don't let the user enter a file name in the file\n\
9931 selection dialog's entry field, if MUSTMATCH is non-nil.")
9932 (prompt
, dir
, default_filename
, mustmatch
)
9933 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
9936 struct frame
*f
= SELECTED_FRAME ();
9937 Lisp_Object file
= Qnil
;
9938 Widget dialog
, text
, list
, help
;
9941 extern XtAppContext Xt_app_con
;
9943 XmString dir_xmstring
, pattern_xmstring
;
9944 int popup_activated_flag
;
9945 int count
= specpdl_ptr
- specpdl
;
9946 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
9948 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
9949 CHECK_STRING (prompt
, 0);
9950 CHECK_STRING (dir
, 1);
9952 /* Prevent redisplay. */
9953 specbind (Qinhibit_redisplay
, Qt
);
9957 /* Create the dialog with PROMPT as title, using DIR as initial
9958 directory and using "*" as pattern. */
9959 dir
= Fexpand_file_name (dir
, Qnil
);
9960 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
9961 pattern_xmstring
= XmStringCreateLocalized ("*");
9963 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
9964 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
9965 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
9966 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
9967 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
9968 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
9970 XmStringFree (dir_xmstring
);
9971 XmStringFree (pattern_xmstring
);
9973 /* Add callbacks for OK and Cancel. */
9974 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
9975 (XtPointer
) &result
);
9976 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
9977 (XtPointer
) &result
);
9979 /* Disable the help button since we can't display help. */
9980 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
9981 XtSetSensitive (help
, False
);
9983 /* Mark OK button as default. */
9984 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
9985 XmNshowAsDefault
, True
, NULL
);
9987 /* If MUSTMATCH is non-nil, disable the file entry field of the
9988 dialog, so that the user must select a file from the files list
9989 box. We can't remove it because we wouldn't have a way to get at
9990 the result file name, then. */
9991 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
9992 if (!NILP (mustmatch
))
9995 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
9996 XtSetSensitive (text
, False
);
9997 XtSetSensitive (label
, False
);
10000 /* Manage the dialog, so that list boxes get filled. */
10001 XtManageChild (dialog
);
10003 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10004 must include the path for this to work. */
10005 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10006 if (STRINGP (default_filename
))
10008 XmString default_xmstring
;
10012 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10014 if (!XmListItemExists (list
, default_xmstring
))
10016 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10017 XmListAddItem (list
, default_xmstring
, 0);
10021 item_pos
= XmListItemPos (list
, default_xmstring
);
10022 XmStringFree (default_xmstring
);
10024 /* Select the item and scroll it into view. */
10025 XmListSelectPos (list
, item_pos
, True
);
10026 XmListSetPos (list
, item_pos
);
10029 /* Process all events until the user presses Cancel or OK. */
10030 for (result
= 0; result
== 0;)
10033 Widget widget
, parent
;
10035 XtAppNextEvent (Xt_app_con
, &event
);
10037 /* See if the receiver of the event is one of the widgets of
10038 the file selection dialog. If so, dispatch it. If not,
10040 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10042 while (parent
&& parent
!= dialog
)
10043 parent
= XtParent (parent
);
10045 if (parent
== dialog
10046 || (event
.type
== Expose
10047 && !process_expose_from_menu (event
)))
10048 XtDispatchEvent (&event
);
10051 /* Get the result. */
10052 if (result
== XmCR_OK
)
10057 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10058 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10059 XmStringFree (text
);
10060 file
= build_string (data
);
10067 XtUnmanageChild (dialog
);
10068 XtDestroyWidget (dialog
);
10072 /* Make "Cancel" equivalent to C-g. */
10074 Fsignal (Qquit
, Qnil
);
10076 return unbind_to (count
, file
);
10079 #endif /* USE_MOTIF */
10082 /***********************************************************************
10084 ***********************************************************************/
10088 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10089 "Value is non-nil if SPEC is a valid image specification.")
10093 return valid_image_p (spec
) ? Qt
: Qnil
;
10097 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10103 if (valid_image_p (spec
))
10104 id
= lookup_image (SELECTED_FRAME (), spec
);
10106 debug_print (spec
);
10107 return make_number (id
);
10110 #endif /* GLYPH_DEBUG != 0 */
10114 /***********************************************************************
10116 ***********************************************************************/
10121 /* This is zero if not using X windows. */
10124 /* The section below is built by the lisp expression at the top of the file,
10125 just above where these variables are declared. */
10126 /*&&& init symbols here &&&*/
10127 Qauto_raise
= intern ("auto-raise");
10128 staticpro (&Qauto_raise
);
10129 Qauto_lower
= intern ("auto-lower");
10130 staticpro (&Qauto_lower
);
10131 Qbar
= intern ("bar");
10133 Qborder_color
= intern ("border-color");
10134 staticpro (&Qborder_color
);
10135 Qborder_width
= intern ("border-width");
10136 staticpro (&Qborder_width
);
10137 Qbox
= intern ("box");
10139 Qcursor_color
= intern ("cursor-color");
10140 staticpro (&Qcursor_color
);
10141 Qcursor_type
= intern ("cursor-type");
10142 staticpro (&Qcursor_type
);
10143 Qgeometry
= intern ("geometry");
10144 staticpro (&Qgeometry
);
10145 Qicon_left
= intern ("icon-left");
10146 staticpro (&Qicon_left
);
10147 Qicon_top
= intern ("icon-top");
10148 staticpro (&Qicon_top
);
10149 Qicon_type
= intern ("icon-type");
10150 staticpro (&Qicon_type
);
10151 Qicon_name
= intern ("icon-name");
10152 staticpro (&Qicon_name
);
10153 Qinternal_border_width
= intern ("internal-border-width");
10154 staticpro (&Qinternal_border_width
);
10155 Qleft
= intern ("left");
10156 staticpro (&Qleft
);
10157 Qright
= intern ("right");
10158 staticpro (&Qright
);
10159 Qmouse_color
= intern ("mouse-color");
10160 staticpro (&Qmouse_color
);
10161 Qnone
= intern ("none");
10162 staticpro (&Qnone
);
10163 Qparent_id
= intern ("parent-id");
10164 staticpro (&Qparent_id
);
10165 Qscroll_bar_width
= intern ("scroll-bar-width");
10166 staticpro (&Qscroll_bar_width
);
10167 Qsuppress_icon
= intern ("suppress-icon");
10168 staticpro (&Qsuppress_icon
);
10169 Qundefined_color
= intern ("undefined-color");
10170 staticpro (&Qundefined_color
);
10171 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10172 staticpro (&Qvertical_scroll_bars
);
10173 Qvisibility
= intern ("visibility");
10174 staticpro (&Qvisibility
);
10175 Qwindow_id
= intern ("window-id");
10176 staticpro (&Qwindow_id
);
10177 Qouter_window_id
= intern ("outer-window-id");
10178 staticpro (&Qouter_window_id
);
10179 Qx_frame_parameter
= intern ("x-frame-parameter");
10180 staticpro (&Qx_frame_parameter
);
10181 Qx_resource_name
= intern ("x-resource-name");
10182 staticpro (&Qx_resource_name
);
10183 Quser_position
= intern ("user-position");
10184 staticpro (&Quser_position
);
10185 Quser_size
= intern ("user-size");
10186 staticpro (&Quser_size
);
10187 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10188 staticpro (&Qscroll_bar_foreground
);
10189 Qscroll_bar_background
= intern ("scroll-bar-background");
10190 staticpro (&Qscroll_bar_background
);
10191 Qscreen_gamma
= intern ("screen-gamma");
10192 staticpro (&Qscreen_gamma
);
10193 /* This is the end of symbol initialization. */
10195 Qlaplace
= intern ("laplace");
10196 staticpro (&Qlaplace
);
10198 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10199 staticpro (&Qface_set_after_frame_default
);
10201 Fput (Qundefined_color
, Qerror_conditions
,
10202 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10203 Fput (Qundefined_color
, Qerror_message
,
10204 build_string ("Undefined color"));
10206 init_x_parm_symbols ();
10208 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10209 "List of directories to search for bitmap files for X.");
10210 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10212 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10213 "The shape of the pointer when over text.\n\
10214 Changing the value does not affect existing frames\n\
10215 unless you set the mouse color.");
10216 Vx_pointer_shape
= Qnil
;
10218 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10219 "The name Emacs uses to look up X resources.\n\
10220 `x-get-resource' uses this as the first component of the instance name\n\
10221 when requesting resource values.\n\
10222 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10223 was invoked, or to the value specified with the `-name' or `-rn'\n\
10224 switches, if present.\n\
10226 It may be useful to bind this variable locally around a call\n\
10227 to `x-get-resource'. See also the variable `x-resource-class'.");
10228 Vx_resource_name
= Qnil
;
10230 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10231 "The class Emacs uses to look up X resources.\n\
10232 `x-get-resource' uses this as the first component of the instance class\n\
10233 when requesting resource values.\n\
10234 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10236 Setting this variable permanently is not a reasonable thing to do,\n\
10237 but binding this variable locally around a call to `x-get-resource'\n\
10238 is a reasonable practice. See also the variable `x-resource-name'.");
10239 Vx_resource_class
= build_string (EMACS_CLASS
);
10241 #if 0 /* This doesn't really do anything. */
10242 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10243 "The shape of the pointer when not over text.\n\
10244 This variable takes effect when you create a new frame\n\
10245 or when you set the mouse color.");
10247 Vx_nontext_pointer_shape
= Qnil
;
10249 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10250 "The shape of the pointer when Emacs is busy.\n\
10251 This variable takes effect when you create a new frame\n\
10252 or when you set the mouse color.");
10253 Vx_busy_pointer_shape
= Qnil
;
10255 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10256 "Non-zero means Emacs displays a busy cursor on window systems.");
10257 display_busy_cursor_p
= 1;
10259 #if 0 /* This doesn't really do anything. */
10260 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10261 "The shape of the pointer when over the mode line.\n\
10262 This variable takes effect when you create a new frame\n\
10263 or when you set the mouse color.");
10265 Vx_mode_pointer_shape
= Qnil
;
10267 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10268 &Vx_sensitive_text_pointer_shape
,
10269 "The shape of the pointer when over mouse-sensitive text.\n\
10270 This variable takes effect when you create a new frame\n\
10271 or when you set the mouse color.");
10272 Vx_sensitive_text_pointer_shape
= Qnil
;
10274 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10275 "A string indicating the foreground color of the cursor box.");
10276 Vx_cursor_fore_pixel
= Qnil
;
10278 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10279 "Non-nil if no X window manager is in use.\n\
10280 Emacs doesn't try to figure this out; this is always nil\n\
10281 unless you set it to something else.");
10282 /* We don't have any way to find this out, so set it to nil
10283 and maybe the user would like to set it to t. */
10284 Vx_no_window_manager
= Qnil
;
10286 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10287 &Vx_pixel_size_width_font_regexp
,
10288 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10290 Since Emacs gets width of a font matching with this regexp from\n\
10291 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10292 such a font. This is especially effective for such large fonts as\n\
10293 Chinese, Japanese, and Korean.");
10294 Vx_pixel_size_width_font_regexp
= Qnil
;
10296 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10297 "Time after which cached images are removed from the cache.\n\
10298 When an image has not been displayed this many seconds, remove it\n\
10299 from the image cache. Value must be an integer or nil with nil\n\
10300 meaning don't clear the cache.");
10301 Vimage_cache_eviction_delay
= make_number (30 * 60);
10303 DEFVAR_LISP ("image-types", &Vimage_types
,
10304 "List of supported image types.\n\
10305 Each element of the list is a symbol for a supported image type.");
10306 Vimage_types
= Qnil
;
10308 #ifdef USE_X_TOOLKIT
10309 Fprovide (intern ("x-toolkit"));
10312 Fprovide (intern ("motif"));
10315 defsubr (&Sx_get_resource
);
10317 /* X window properties. */
10318 defsubr (&Sx_change_window_property
);
10319 defsubr (&Sx_delete_window_property
);
10320 defsubr (&Sx_window_property
);
10323 defsubr (&Sx_draw_rectangle
);
10324 defsubr (&Sx_erase_rectangle
);
10325 defsubr (&Sx_contour_region
);
10326 defsubr (&Sx_uncontour_region
);
10328 defsubr (&Sxw_display_color_p
);
10329 defsubr (&Sx_display_grayscale_p
);
10330 defsubr (&Sxw_color_defined_p
);
10331 defsubr (&Sxw_color_values
);
10332 defsubr (&Sx_server_max_request_size
);
10333 defsubr (&Sx_server_vendor
);
10334 defsubr (&Sx_server_version
);
10335 defsubr (&Sx_display_pixel_width
);
10336 defsubr (&Sx_display_pixel_height
);
10337 defsubr (&Sx_display_mm_width
);
10338 defsubr (&Sx_display_mm_height
);
10339 defsubr (&Sx_display_screens
);
10340 defsubr (&Sx_display_planes
);
10341 defsubr (&Sx_display_color_cells
);
10342 defsubr (&Sx_display_visual_class
);
10343 defsubr (&Sx_display_backing_store
);
10344 defsubr (&Sx_display_save_under
);
10346 defsubr (&Sx_rebind_key
);
10347 defsubr (&Sx_rebind_keys
);
10348 defsubr (&Sx_track_pointer
);
10349 defsubr (&Sx_grab_pointer
);
10350 defsubr (&Sx_ungrab_pointer
);
10352 defsubr (&Sx_parse_geometry
);
10353 defsubr (&Sx_create_frame
);
10355 defsubr (&Sx_horizontal_line
);
10357 defsubr (&Sx_open_connection
);
10358 defsubr (&Sx_close_connection
);
10359 defsubr (&Sx_display_list
);
10360 defsubr (&Sx_synchronize
);
10362 /* Setting callback functions for fontset handler. */
10363 get_font_info_func
= x_get_font_info
;
10365 #if 0 /* This function pointer doesn't seem to be used anywhere.
10366 And the pointer assigned has the wrong type, anyway. */
10367 list_fonts_func
= x_list_fonts
;
10370 load_font_func
= x_load_font
;
10371 find_ccl_program_func
= x_find_ccl_program
;
10372 query_font_func
= x_query_font
;
10373 set_frame_fontset_func
= x_set_font
;
10374 check_window_system_func
= check_x
;
10377 Qxbm
= intern ("xbm");
10379 QCtype
= intern (":type");
10380 staticpro (&QCtype
);
10381 QCalgorithm
= intern (":algorithm");
10382 staticpro (&QCalgorithm
);
10383 QCheuristic_mask
= intern (":heuristic-mask");
10384 staticpro (&QCheuristic_mask
);
10385 QCcolor_symbols
= intern (":color-symbols");
10386 staticpro (&QCcolor_symbols
);
10387 QCdata
= intern (":data");
10388 staticpro (&QCdata
);
10389 QCascent
= intern (":ascent");
10390 staticpro (&QCascent
);
10391 QCmargin
= intern (":margin");
10392 staticpro (&QCmargin
);
10393 QCrelief
= intern (":relief");
10394 staticpro (&QCrelief
);
10395 Qpostscript
= intern ("postscript");
10396 staticpro (&Qpostscript
);
10397 QCloader
= intern (":loader");
10398 staticpro (&QCloader
);
10399 QCbounding_box
= intern (":bounding-box");
10400 staticpro (&QCbounding_box
);
10401 QCpt_width
= intern (":pt-width");
10402 staticpro (&QCpt_width
);
10403 QCpt_height
= intern (":pt-height");
10404 staticpro (&QCpt_height
);
10405 QCindex
= intern (":index");
10406 staticpro (&QCindex
);
10407 Qpbm
= intern ("pbm");
10411 Qxpm
= intern ("xpm");
10416 Qjpeg
= intern ("jpeg");
10417 staticpro (&Qjpeg
);
10421 Qtiff
= intern ("tiff");
10422 staticpro (&Qtiff
);
10426 Qgif
= intern ("gif");
10431 Qpng
= intern ("png");
10435 defsubr (&Sclear_image_cache
);
10438 defsubr (&Simagep
);
10439 defsubr (&Slookup_image
);
10443 defsubr (&Sx_show_busy_cursor
);
10444 defsubr (&Sx_hide_busy_cursor
);
10446 inhibit_busy_cursor
= 0;
10448 defsubr (&Sx_show_tip
);
10449 defsubr (&Sx_hide_tip
);
10450 staticpro (&tip_timer
);
10454 defsubr (&Sx_file_dialog
);
10462 image_types
= NULL
;
10463 Vimage_types
= Qnil
;
10465 define_image_type (&xbm_type
);
10466 define_image_type (&gs_type
);
10467 define_image_type (&pbm_type
);
10470 define_image_type (&xpm_type
);
10474 define_image_type (&jpeg_type
);
10478 define_image_type (&tiff_type
);
10482 define_image_type (&gif_type
);
10486 define_image_type (&png_type
);
10490 #endif /* HAVE_X_WINDOWS */