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. */
27 /* This makes the fields of a Display accessible, in Xlib header files. */
29 #define XLIB_ILLEGAL_ACCESS
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
44 #include "termhooks.h"
49 #include <sys/types.h>
52 /* On some systems, the character-composition stuff is broken in X11R5. */
54 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
55 #ifdef X11R5_INHIBIT_I18N
56 #define X_I18N_INHIBITED
61 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
62 #include "bitmaps/gray.xbm"
64 #include <X11/bitmaps/gray>
67 #include "[.bitmaps]gray.xbm"
71 #include <X11/Shell.h>
74 #include <X11/Xaw/Paned.h>
75 #include <X11/Xaw/Label.h>
76 #endif /* USE_MOTIF */
79 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
88 #include "../lwlib/lwlib.h"
92 #include <Xm/DialogS.h>
93 #include <Xm/FileSB.h>
96 /* Do the EDITRES protocol if running X11R5
97 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
99 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
101 extern void _XEditResCheckMessages ();
102 #endif /* R5 + Athena */
104 /* Unique id counter for widgets created by the Lucid Widget Library. */
106 extern LWLIB_ID widget_id_tick
;
109 /* This is part of a kludge--see lwlib/xlwmenu.c. */
110 extern XFontStruct
*xlwmenu_default_font
;
113 extern void free_frame_menubar ();
114 extern double atof ();
116 #endif /* USE_X_TOOLKIT */
118 #define min(a,b) ((a) < (b) ? (a) : (b))
119 #define max(a,b) ((a) > (b) ? (a) : (b))
122 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
124 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
127 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
128 it, and including `bitmaps/gray' more than once is a problem when
129 config.h defines `static' as an empty replacement string. */
131 int gray_bitmap_width
= gray_width
;
132 int gray_bitmap_height
= gray_height
;
133 unsigned char *gray_bitmap_bits
= gray_bits
;
135 /* The name we're using in resource queries. Most often "emacs". */
137 Lisp_Object Vx_resource_name
;
139 /* The application class we're using in resource queries.
142 Lisp_Object Vx_resource_class
;
144 /* Non-zero means we're allowed to display a busy cursor. */
146 int display_busy_cursor_p
;
148 /* The background and shape of the mouse pointer, and shape when not
149 over text or in the modeline. */
151 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
152 Lisp_Object Vx_busy_pointer_shape
;
154 /* The shape when over mouse-sensitive text. */
156 Lisp_Object Vx_sensitive_text_pointer_shape
;
158 /* Color of chars displayed in cursor box. */
160 Lisp_Object Vx_cursor_fore_pixel
;
162 /* Nonzero if using X. */
166 /* Non nil if no window manager is in use. */
168 Lisp_Object Vx_no_window_manager
;
170 /* Search path for bitmap files. */
172 Lisp_Object Vx_bitmap_file_path
;
174 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
176 Lisp_Object Vx_pixel_size_width_font_regexp
;
178 /* Evaluate this expression to rebuild the section of syms_of_xfns
179 that initializes and staticpros the symbols declared below. Note
180 that Emacs 18 has a bug that keeps C-x C-e from being able to
181 evaluate this expression.
184 ;; Accumulate a list of the symbols we want to initialize from the
185 ;; declarations at the top of the file.
186 (goto-char (point-min))
187 (search-forward "/\*&&& symbols declared here &&&*\/\n")
189 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
191 (cons (buffer-substring (match-beginning 1) (match-end 1))
194 (setq symbol-list (nreverse symbol-list))
195 ;; Delete the section of syms_of_... where we initialize the symbols.
196 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
197 (let ((start (point)))
198 (while (looking-at "^ Q")
200 (kill-region start (point)))
201 ;; Write a new symbol initialization section.
203 (insert (format " %s = intern (\"" (car symbol-list)))
204 (let ((start (point)))
205 (insert (substring (car symbol-list) 1))
206 (subst-char-in-region start (point) ?_ ?-))
207 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
208 (setq symbol-list (cdr symbol-list)))))
212 /*&&& symbols declared here &&&*/
213 Lisp_Object Qauto_raise
;
214 Lisp_Object Qauto_lower
;
216 Lisp_Object Qborder_color
;
217 Lisp_Object Qborder_width
;
219 Lisp_Object Qcursor_color
;
220 Lisp_Object Qcursor_type
;
221 Lisp_Object Qgeometry
;
222 Lisp_Object Qicon_left
;
223 Lisp_Object Qicon_top
;
224 Lisp_Object Qicon_type
;
225 Lisp_Object Qicon_name
;
226 Lisp_Object Qinternal_border_width
;
229 Lisp_Object Qmouse_color
;
231 Lisp_Object Qouter_window_id
;
232 Lisp_Object Qparent_id
;
233 Lisp_Object Qscroll_bar_width
;
234 Lisp_Object Qsuppress_icon
;
235 extern Lisp_Object Qtop
;
236 Lisp_Object Qundefined_color
;
237 Lisp_Object Qvertical_scroll_bars
;
238 Lisp_Object Qvisibility
;
239 Lisp_Object Qwindow_id
;
240 Lisp_Object Qx_frame_parameter
;
241 Lisp_Object Qx_resource_name
;
242 Lisp_Object Quser_position
;
243 Lisp_Object Quser_size
;
244 extern Lisp_Object Qdisplay
;
245 Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
246 Lisp_Object Qscreen_gamma
;
248 /* The below are defined in frame.c. */
250 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
251 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
252 extern Lisp_Object Qtool_bar_lines
;
254 extern Lisp_Object Vwindow_system_version
;
256 Lisp_Object Qface_set_after_frame_default
;
259 /* Error if we are not connected to X. */
265 error ("X windows are not in use or not initialized");
268 /* Nonzero if we can use mouse menus.
269 You should not call this unless HAVE_MENUS is defined. */
277 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
278 and checking validity for X. */
281 check_x_frame (frame
)
287 frame
= selected_frame
;
288 CHECK_LIVE_FRAME (frame
, 0);
291 error ("Non-X frame used");
295 /* Let the user specify an X display with a frame.
296 nil stands for the selected frame--or, if that is not an X frame,
297 the first X display on the list. */
299 static struct x_display_info
*
300 check_x_display_info (frame
)
305 struct frame
*sf
= XFRAME (selected_frame
);
307 if (FRAME_X_P (sf
) && FRAME_LIVE_P (sf
))
308 return FRAME_X_DISPLAY_INFO (sf
);
309 else if (x_display_list
!= 0)
310 return x_display_list
;
312 error ("X windows are not in use or not initialized");
314 else if (STRINGP (frame
))
315 return x_display_info_for_name (frame
);
320 CHECK_LIVE_FRAME (frame
, 0);
323 error ("Non-X frame used");
324 return FRAME_X_DISPLAY_INFO (f
);
329 /* Return the Emacs frame-object corresponding to an X window.
330 It could be the frame's main window or an icon window. */
332 /* This function can be called during GC, so use GC_xxx type test macros. */
335 x_window_to_frame (dpyinfo
, wdesc
)
336 struct x_display_info
*dpyinfo
;
339 Lisp_Object tail
, frame
;
342 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
345 if (!GC_FRAMEP (frame
))
348 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
351 if ((f
->output_data
.x
->edit_widget
352 && XtWindow (f
->output_data
.x
->edit_widget
) == wdesc
)
353 /* A tooltip frame? */
354 || (!f
->output_data
.x
->edit_widget
355 && FRAME_X_WINDOW (f
) == wdesc
)
356 || f
->output_data
.x
->icon_desc
== wdesc
)
358 #else /* not USE_X_TOOLKIT */
359 if (FRAME_X_WINDOW (f
) == wdesc
360 || f
->output_data
.x
->icon_desc
== wdesc
)
362 #endif /* not USE_X_TOOLKIT */
368 /* Like x_window_to_frame but also compares the window with the widget's
372 x_any_window_to_frame (dpyinfo
, wdesc
)
373 struct x_display_info
*dpyinfo
;
376 Lisp_Object tail
, frame
;
380 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
383 if (!GC_FRAMEP (frame
))
386 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
388 x
= f
->output_data
.x
;
389 /* This frame matches if the window is any of its widgets. */
392 if (wdesc
== XtWindow (x
->widget
)
393 || wdesc
== XtWindow (x
->column_widget
)
394 || wdesc
== XtWindow (x
->edit_widget
))
396 /* Match if the window is this frame's menubar. */
397 if (lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
400 else if (FRAME_X_WINDOW (f
) == wdesc
)
401 /* A tooltip frame. */
407 /* Likewise, but exclude the menu bar widget. */
410 x_non_menubar_window_to_frame (dpyinfo
, wdesc
)
411 struct x_display_info
*dpyinfo
;
414 Lisp_Object tail
, frame
;
418 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
421 if (!GC_FRAMEP (frame
))
424 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
426 x
= f
->output_data
.x
;
427 /* This frame matches if the window is any of its widgets. */
430 if (wdesc
== XtWindow (x
->widget
)
431 || wdesc
== XtWindow (x
->column_widget
)
432 || wdesc
== XtWindow (x
->edit_widget
))
435 else if (FRAME_X_WINDOW (f
) == wdesc
)
436 /* A tooltip frame. */
442 /* Likewise, but consider only the menu bar widget. */
445 x_menubar_window_to_frame (dpyinfo
, wdesc
)
446 struct x_display_info
*dpyinfo
;
449 Lisp_Object tail
, frame
;
453 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
456 if (!GC_FRAMEP (frame
))
459 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
461 x
= f
->output_data
.x
;
462 /* Match if the window is this frame's menubar. */
463 if (x
->menubar_widget
464 && lw_window_is_in_menubar (wdesc
, x
->menubar_widget
))
470 /* Return the frame whose principal (outermost) window is WDESC.
471 If WDESC is some other (smaller) window, we return 0. */
474 x_top_window_to_frame (dpyinfo
, wdesc
)
475 struct x_display_info
*dpyinfo
;
478 Lisp_Object tail
, frame
;
482 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
485 if (!GC_FRAMEP (frame
))
488 if (!FRAME_X_P (f
) || FRAME_X_DISPLAY_INFO (f
) != dpyinfo
)
490 x
= f
->output_data
.x
;
494 /* This frame matches if the window is its topmost widget. */
495 if (wdesc
== XtWindow (x
->widget
))
497 #if 0 /* I don't know why it did this,
498 but it seems logically wrong,
499 and it causes trouble for MapNotify events. */
500 /* Match if the window is this frame's menubar. */
501 if (x
->menubar_widget
502 && wdesc
== XtWindow (x
->menubar_widget
))
506 else if (FRAME_X_WINDOW (f
) == wdesc
)
512 #endif /* USE_X_TOOLKIT */
516 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
517 id, which is just an int that this section returns. Bitmaps are
518 reference counted so they can be shared among frames.
520 Bitmap indices are guaranteed to be > 0, so a negative number can
521 be used to indicate no bitmap.
523 If you use x_create_bitmap_from_data, then you must keep track of
524 the bitmaps yourself. That is, creating a bitmap from the same
525 data more than once will not be caught. */
528 /* Functions to access the contents of a bitmap, given an id. */
531 x_bitmap_height (f
, id
)
535 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
539 x_bitmap_width (f
, id
)
543 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
547 x_bitmap_pixmap (f
, id
)
551 return FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
555 /* Allocate a new bitmap record. Returns index of new record. */
558 x_allocate_bitmap_record (f
)
561 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
564 if (dpyinfo
->bitmaps
== NULL
)
566 dpyinfo
->bitmaps_size
= 10;
568 = (struct x_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
569 dpyinfo
->bitmaps_last
= 1;
573 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
574 return ++dpyinfo
->bitmaps_last
;
576 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
577 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
580 dpyinfo
->bitmaps_size
*= 2;
582 = (struct x_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
583 dpyinfo
->bitmaps_size
* sizeof (struct x_bitmap_record
));
584 return ++dpyinfo
->bitmaps_last
;
587 /* Add one reference to the reference count of the bitmap with id ID. */
590 x_reference_bitmap (f
, id
)
594 ++FRAME_X_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
597 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
600 x_create_bitmap_from_data (f
, bits
, width
, height
)
603 unsigned int width
, height
;
605 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
609 bitmap
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
610 bits
, width
, height
);
615 id
= x_allocate_bitmap_record (f
);
616 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
617 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
618 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
619 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
620 dpyinfo
->bitmaps
[id
- 1].height
= height
;
621 dpyinfo
->bitmaps
[id
- 1].width
= width
;
626 /* Create bitmap from file FILE for frame F. */
629 x_create_bitmap_from_file (f
, file
)
633 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
634 unsigned int width
, height
;
636 int xhot
, yhot
, result
, id
;
641 /* Look for an existing bitmap with the same name. */
642 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
644 if (dpyinfo
->bitmaps
[id
].refcount
645 && dpyinfo
->bitmaps
[id
].file
646 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
648 ++dpyinfo
->bitmaps
[id
].refcount
;
653 /* Search bitmap-file-path for the file, if appropriate. */
654 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
657 /* XReadBitmapFile won't handle magic file names. */
662 filename
= (char *) XSTRING (found
)->data
;
664 result
= XReadBitmapFile (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
665 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
666 if (result
!= BitmapSuccess
)
669 id
= x_allocate_bitmap_record (f
);
670 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
671 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
672 dpyinfo
->bitmaps
[id
- 1].file
673 = (char *) xmalloc (STRING_BYTES (XSTRING (file
)) + 1);
674 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
675 dpyinfo
->bitmaps
[id
- 1].height
= height
;
676 dpyinfo
->bitmaps
[id
- 1].width
= width
;
677 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
682 /* Remove reference to bitmap with id number ID. */
685 x_destroy_bitmap (f
, id
)
689 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
693 --dpyinfo
->bitmaps
[id
- 1].refcount
;
694 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
697 XFreePixmap (FRAME_X_DISPLAY (f
), dpyinfo
->bitmaps
[id
- 1].pixmap
);
698 if (dpyinfo
->bitmaps
[id
- 1].file
)
700 xfree (dpyinfo
->bitmaps
[id
- 1].file
);
701 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
708 /* Free all the bitmaps for the display specified by DPYINFO. */
711 x_destroy_all_bitmaps (dpyinfo
)
712 struct x_display_info
*dpyinfo
;
715 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
716 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
718 XFreePixmap (dpyinfo
->display
, dpyinfo
->bitmaps
[i
].pixmap
);
719 if (dpyinfo
->bitmaps
[i
].file
)
720 xfree (dpyinfo
->bitmaps
[i
].file
);
722 dpyinfo
->bitmaps_last
= 0;
725 /* Connect the frame-parameter names for X frames
726 to the ways of passing the parameter values to the window system.
728 The name of a parameter, as a Lisp symbol,
729 has an `x-frame-parameter' property which is an integer in Lisp
730 that is an index in this table. */
732 struct x_frame_parm_table
735 void (*setter
) P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
738 static void x_create_im
P_ ((struct frame
*));
739 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
749 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
751 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
754 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
756 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
762 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
764 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
766 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
771 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
773 static struct x_frame_parm_table x_frame_parms
[] =
775 "auto-raise", x_set_autoraise
,
776 "auto-lower", x_set_autolower
,
777 "background-color", x_set_background_color
,
778 "border-color", x_set_border_color
,
779 "border-width", x_set_border_width
,
780 "cursor-color", x_set_cursor_color
,
781 "cursor-type", x_set_cursor_type
,
783 "foreground-color", x_set_foreground_color
,
784 "icon-name", x_set_icon_name
,
785 "icon-type", x_set_icon_type
,
786 "internal-border-width", x_set_internal_border_width
,
787 "menu-bar-lines", x_set_menu_bar_lines
,
788 "mouse-color", x_set_mouse_color
,
789 "name", x_explicitly_set_name
,
790 "scroll-bar-width", x_set_scroll_bar_width
,
791 "title", x_set_title
,
792 "unsplittable", x_set_unsplittable
,
793 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
794 "visibility", x_set_visibility
,
795 "tool-bar-lines", x_set_tool_bar_lines
,
796 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
797 "scroll-bar-background", x_set_scroll_bar_background
,
798 "screen-gamma", x_set_screen_gamma
801 /* Attach the `x-frame-parameter' properties to
802 the Lisp symbol names of parameters relevant to X. */
805 init_x_parm_symbols ()
809 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
810 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
814 /* Change the parameters of frame F as specified by ALIST.
815 If a parameter is not specially recognized, do nothing;
816 otherwise call the `x_set_...' function for that parameter. */
819 x_set_frame_parameters (f
, alist
)
825 /* If both of these parameters are present, it's more efficient to
826 set them both at once. So we wait until we've looked at the
827 entire list before we set them. */
831 Lisp_Object left
, top
;
833 /* Same with these. */
834 Lisp_Object icon_left
, icon_top
;
836 /* Record in these vectors all the parms specified. */
840 int left_no_change
= 0, top_no_change
= 0;
841 int icon_left_no_change
= 0, icon_top_no_change
= 0;
843 struct gcpro gcpro1
, gcpro2
;
846 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
849 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
850 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
852 /* Extract parm names and values into those vectors. */
855 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
860 parms
[i
] = Fcar (elt
);
861 values
[i
] = Fcdr (elt
);
864 /* TAIL and ALIST are not used again below here. */
867 GCPRO2 (*parms
, *values
);
871 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
872 because their values appear in VALUES and strings are not valid. */
873 top
= left
= Qunbound
;
874 icon_left
= icon_top
= Qunbound
;
876 /* Provide default values for HEIGHT and WIDTH. */
877 if (FRAME_NEW_WIDTH (f
))
878 width
= FRAME_NEW_WIDTH (f
);
880 width
= FRAME_WIDTH (f
);
882 if (FRAME_NEW_HEIGHT (f
))
883 height
= FRAME_NEW_HEIGHT (f
);
885 height
= FRAME_HEIGHT (f
);
887 /* Process foreground_color and background_color before anything else.
888 They are independent of other properties, but other properties (e.g.,
889 cursor_color) are dependent upon them. */
890 for (p
= 0; p
< i
; p
++)
892 Lisp_Object prop
, val
;
896 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
898 register Lisp_Object param_index
, old_value
;
900 param_index
= Fget (prop
, Qx_frame_parameter
);
901 old_value
= get_frame_param (f
, prop
);
902 store_frame_param (f
, prop
, val
);
903 if (NATNUMP (param_index
)
904 && (XFASTINT (param_index
)
905 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
906 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
910 /* Now process them in reverse of specified order. */
911 for (i
--; i
>= 0; i
--)
913 Lisp_Object prop
, val
;
918 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
919 width
= XFASTINT (val
);
920 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
921 height
= XFASTINT (val
);
922 else if (EQ (prop
, Qtop
))
924 else if (EQ (prop
, Qleft
))
926 else if (EQ (prop
, Qicon_top
))
928 else if (EQ (prop
, Qicon_left
))
930 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
931 /* Processed above. */
935 register Lisp_Object param_index
, old_value
;
937 param_index
= Fget (prop
, Qx_frame_parameter
);
938 old_value
= get_frame_param (f
, prop
);
939 store_frame_param (f
, prop
, val
);
940 if (NATNUMP (param_index
)
941 && (XFASTINT (param_index
)
942 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
943 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
947 /* Don't die if just one of these was set. */
948 if (EQ (left
, Qunbound
))
951 if (f
->output_data
.x
->left_pos
< 0)
952 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
954 XSETINT (left
, f
->output_data
.x
->left_pos
);
956 if (EQ (top
, Qunbound
))
959 if (f
->output_data
.x
->top_pos
< 0)
960 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
962 XSETINT (top
, f
->output_data
.x
->top_pos
);
965 /* If one of the icon positions was not set, preserve or default it. */
966 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
968 icon_left_no_change
= 1;
969 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
970 if (NILP (icon_left
))
971 XSETINT (icon_left
, 0);
973 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
975 icon_top_no_change
= 1;
976 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
978 XSETINT (icon_top
, 0);
981 /* Don't set these parameters unless they've been explicitly
982 specified. The window might be mapped or resized while we're in
983 this function, and we don't want to override that unless the lisp
984 code has asked for it.
986 Don't set these parameters unless they actually differ from the
987 window's current parameters; the window may not actually exist
992 check_frame_size (f
, &height
, &width
);
994 XSETFRAME (frame
, f
);
996 if (width
!= FRAME_WIDTH (f
)
997 || height
!= FRAME_HEIGHT (f
)
998 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
999 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1001 if ((!NILP (left
) || !NILP (top
))
1002 && ! (left_no_change
&& top_no_change
)
1003 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1004 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1009 /* Record the signs. */
1010 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1011 if (EQ (left
, Qminus
))
1012 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1013 else if (INTEGERP (left
))
1015 leftpos
= XINT (left
);
1017 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1019 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1020 && CONSP (XCDR (left
))
1021 && INTEGERP (XCAR (XCDR (left
))))
1023 leftpos
= - XINT (XCAR (XCDR (left
)));
1024 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1026 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1027 && CONSP (XCDR (left
))
1028 && INTEGERP (XCAR (XCDR (left
))))
1030 leftpos
= XINT (XCAR (XCDR (left
)));
1033 if (EQ (top
, Qminus
))
1034 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1035 else if (INTEGERP (top
))
1037 toppos
= XINT (top
);
1039 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1041 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1042 && CONSP (XCDR (top
))
1043 && INTEGERP (XCAR (XCDR (top
))))
1045 toppos
= - XINT (XCAR (XCDR (top
)));
1046 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1048 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1049 && CONSP (XCDR (top
))
1050 && INTEGERP (XCAR (XCDR (top
))))
1052 toppos
= XINT (XCAR (XCDR (top
)));
1056 /* Store the numeric value of the position. */
1057 f
->output_data
.x
->top_pos
= toppos
;
1058 f
->output_data
.x
->left_pos
= leftpos
;
1060 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1062 /* Actually set that position, and convert to absolute. */
1063 x_set_offset (f
, leftpos
, toppos
, -1);
1066 if ((!NILP (icon_left
) || !NILP (icon_top
))
1067 && ! (icon_left_no_change
&& icon_top_no_change
))
1068 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1074 /* Store the screen positions of frame F into XPTR and YPTR.
1075 These are the positions of the containing window manager window,
1076 not Emacs's own window. */
1079 x_real_positions (f
, xptr
, yptr
)
1086 /* This is pretty gross, but seems to be the easiest way out of
1087 the problem that arises when restarting window-managers. */
1089 #ifdef USE_X_TOOLKIT
1090 Window outer
= (f
->output_data
.x
->widget
1091 ? XtWindow (f
->output_data
.x
->widget
)
1092 : FRAME_X_WINDOW (f
));
1094 Window outer
= f
->output_data
.x
->window_desc
;
1096 Window tmp_root_window
;
1097 Window
*tmp_children
;
1102 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1103 Window outer_window
;
1105 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1106 &f
->output_data
.x
->parent_desc
,
1107 &tmp_children
, &tmp_nchildren
);
1108 XFree ((char *) tmp_children
);
1112 /* Find the position of the outside upper-left corner of
1113 the inner window, with respect to the outer window. */
1114 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1115 outer_window
= f
->output_data
.x
->parent_desc
;
1117 outer_window
= outer
;
1119 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1121 /* From-window, to-window. */
1123 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1125 /* From-position, to-position. */
1126 0, 0, &win_x
, &win_y
,
1131 /* It is possible for the window returned by the XQueryNotify
1132 to become invalid by the time we call XTranslateCoordinates.
1133 That can happen when you restart some window managers.
1134 If so, we get an error in XTranslateCoordinates.
1135 Detect that and try the whole thing over. */
1136 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1138 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1142 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1149 /* Insert a description of internally-recorded parameters of frame X
1150 into the parameter alist *ALISTPTR that is to be given to the user.
1151 Only parameters that are specific to the X window system
1152 and whose values are not correctly recorded in the frame's
1153 param_alist need to be considered here. */
1156 x_report_frame_params (f
, alistptr
)
1158 Lisp_Object
*alistptr
;
1163 /* Represent negative positions (off the top or left screen edge)
1164 in a way that Fmodify_frame_parameters will understand correctly. */
1165 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1166 if (f
->output_data
.x
->left_pos
>= 0)
1167 store_in_alist (alistptr
, Qleft
, tem
);
1169 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1171 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1172 if (f
->output_data
.x
->top_pos
>= 0)
1173 store_in_alist (alistptr
, Qtop
, tem
);
1175 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1177 store_in_alist (alistptr
, Qborder_width
,
1178 make_number (f
->output_data
.x
->border_width
));
1179 store_in_alist (alistptr
, Qinternal_border_width
,
1180 make_number (f
->output_data
.x
->internal_border_width
));
1181 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1182 store_in_alist (alistptr
, Qwindow_id
,
1183 build_string (buf
));
1184 #ifdef USE_X_TOOLKIT
1185 /* Tooltip frame may not have this widget. */
1186 if (f
->output_data
.x
->widget
)
1188 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1189 store_in_alist (alistptr
, Qouter_window_id
,
1190 build_string (buf
));
1191 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1192 FRAME_SAMPLE_VISIBILITY (f
);
1193 store_in_alist (alistptr
, Qvisibility
,
1194 (FRAME_VISIBLE_P (f
) ? Qt
1195 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1196 store_in_alist (alistptr
, Qdisplay
,
1197 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1199 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1202 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1203 store_in_alist (alistptr
, Qparent_id
, tem
);
1208 /* Gamma-correct COLOR on frame F. */
1211 gamma_correct (f
, color
)
1217 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1218 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1219 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1224 /* Decide if color named COLOR is valid for the display associated with
1225 the selected frame; if so, return the rgb values in COLOR_DEF.
1226 If ALLOC is nonzero, allocate a new colormap cell. */
1229 x_defined_color (f
, color
, color_def
, alloc
)
1235 register int status
;
1236 Colormap screen_colormap
;
1237 Display
*display
= FRAME_X_DISPLAY (f
);
1240 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1242 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1243 if (status
&& alloc
)
1245 /* Apply gamma correction. */
1246 gamma_correct (f
, color_def
);
1248 status
= XAllocColor (display
, screen_colormap
, color_def
);
1251 /* If we got to this point, the colormap is full, so we're
1252 going to try and get the next closest color.
1253 The algorithm used is a least-squares matching, which is
1254 what X uses for closest color matching with StaticColor visuals. */
1259 long nearest_delta
, trial_delta
;
1262 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1263 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1265 for (x
= 0; x
< no_cells
; x
++)
1268 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1270 /* I'm assuming CSE so I'm not going to condense this. */
1271 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1272 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1274 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1275 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1277 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1278 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1279 for (x
= 1; x
< no_cells
; x
++)
1281 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1282 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1284 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1285 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1287 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1288 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1289 if (trial_delta
< nearest_delta
)
1292 temp
.red
= cells
[x
].red
;
1293 temp
.green
= cells
[x
].green
;
1294 temp
.blue
= cells
[x
].blue
;
1295 status
= XAllocColor (display
, screen_colormap
, &temp
);
1299 nearest_delta
= trial_delta
;
1303 color_def
->red
= cells
[nearest
].red
;
1304 color_def
->green
= cells
[nearest
].green
;
1305 color_def
->blue
= cells
[nearest
].blue
;
1306 status
= XAllocColor (display
, screen_colormap
, color_def
);
1317 /* Given a string ARG naming a color, compute a pixel value from it
1318 suitable for screen F.
1319 If F is not a color screen, return DEF (default) regardless of what
1323 x_decode_color (f
, arg
, def
)
1330 CHECK_STRING (arg
, 0);
1332 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1333 return BLACK_PIX_DEFAULT (f
);
1334 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1335 return WHITE_PIX_DEFAULT (f
);
1337 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1340 /* x_defined_color is responsible for coping with failures
1341 by looking for a near-miss. */
1342 if (x_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1345 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1346 Fcons (arg
, Qnil
)));
1349 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1350 the previous value of that parameter, NEW_VALUE is the new value. */
1353 x_set_screen_gamma (f
, new_value
, old_value
)
1355 Lisp_Object new_value
, old_value
;
1357 if (NILP (new_value
))
1359 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1360 /* The value 0.4545 is the normal viewing gamma. */
1361 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1363 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1364 Fcons (new_value
, Qnil
)));
1366 clear_face_cache (0);
1370 /* Functions called only from `x_set_frame_param'
1371 to set individual parameters.
1373 If FRAME_X_WINDOW (f) is 0,
1374 the frame is being created and its X-window does not exist yet.
1375 In that case, just record the parameter's new value
1376 in the standard place; do not attempt to change the window. */
1379 x_set_foreground_color (f
, arg
, oldval
)
1381 Lisp_Object arg
, oldval
;
1384 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1386 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1387 f
->output_data
.x
->foreground_pixel
= pixel
;
1389 if (FRAME_X_WINDOW (f
) != 0)
1392 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1393 f
->output_data
.x
->foreground_pixel
);
1394 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1395 f
->output_data
.x
->foreground_pixel
);
1397 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1398 if (FRAME_VISIBLE_P (f
))
1404 x_set_background_color (f
, arg
, oldval
)
1406 Lisp_Object arg
, oldval
;
1409 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1411 unload_color (f
, f
->output_data
.x
->background_pixel
);
1412 f
->output_data
.x
->background_pixel
= pixel
;
1414 if (FRAME_X_WINDOW (f
) != 0)
1417 /* The main frame area. */
1418 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1419 f
->output_data
.x
->background_pixel
);
1420 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1421 f
->output_data
.x
->background_pixel
);
1422 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1423 f
->output_data
.x
->background_pixel
);
1424 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1425 f
->output_data
.x
->background_pixel
);
1428 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1429 bar
= XSCROLL_BAR (bar
)->next
)
1430 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1431 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1432 f
->output_data
.x
->background_pixel
);
1436 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1438 if (FRAME_VISIBLE_P (f
))
1444 x_set_mouse_color (f
, arg
, oldval
)
1446 Lisp_Object arg
, oldval
;
1448 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1451 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1452 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1454 /* Don't let pointers be invisible. */
1455 if (mask_color
== pixel
1456 && mask_color
== f
->output_data
.x
->background_pixel
)
1457 pixel
= f
->output_data
.x
->foreground_pixel
;
1459 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1460 f
->output_data
.x
->mouse_pixel
= pixel
;
1464 /* It's not okay to crash if the user selects a screwy cursor. */
1465 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1467 if (!EQ (Qnil
, Vx_pointer_shape
))
1469 CHECK_NUMBER (Vx_pointer_shape
, 0);
1470 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1473 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1474 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1476 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1478 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1479 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1480 XINT (Vx_nontext_pointer_shape
));
1483 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1484 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1486 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1488 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1489 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1490 XINT (Vx_busy_pointer_shape
));
1493 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1494 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1496 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1497 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1499 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1500 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1501 XINT (Vx_mode_pointer_shape
));
1504 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1505 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1507 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1509 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1511 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1512 XINT (Vx_sensitive_text_pointer_shape
));
1515 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1517 /* Check and report errors with the above calls. */
1518 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1519 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1522 XColor fore_color
, back_color
;
1524 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1525 back_color
.pixel
= mask_color
;
1526 XQueryColor (FRAME_X_DISPLAY (f
),
1527 DefaultColormap (FRAME_X_DISPLAY (f
),
1528 DefaultScreen (FRAME_X_DISPLAY (f
))),
1530 XQueryColor (FRAME_X_DISPLAY (f
),
1531 DefaultColormap (FRAME_X_DISPLAY (f
),
1532 DefaultScreen (FRAME_X_DISPLAY (f
))),
1534 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1535 &fore_color
, &back_color
);
1536 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1537 &fore_color
, &back_color
);
1538 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1539 &fore_color
, &back_color
);
1540 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1541 &fore_color
, &back_color
);
1542 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1543 &fore_color
, &back_color
);
1546 if (FRAME_X_WINDOW (f
) != 0)
1547 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1549 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1550 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1551 f
->output_data
.x
->text_cursor
= cursor
;
1553 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1554 && f
->output_data
.x
->nontext_cursor
!= 0)
1555 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1556 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1558 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1559 && f
->output_data
.x
->busy_cursor
!= 0)
1560 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1561 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1563 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1564 && f
->output_data
.x
->modeline_cursor
!= 0)
1565 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1566 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1568 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1569 && f
->output_data
.x
->cross_cursor
!= 0)
1570 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1571 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1573 XFlush (FRAME_X_DISPLAY (f
));
1576 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1580 x_set_cursor_color (f
, arg
, oldval
)
1582 Lisp_Object arg
, oldval
;
1584 unsigned long fore_pixel
, pixel
;
1586 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1587 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1588 WHITE_PIX_DEFAULT (f
));
1590 fore_pixel
= f
->output_data
.x
->background_pixel
;
1591 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1593 /* Make sure that the cursor color differs from the background color. */
1594 if (pixel
== f
->output_data
.x
->background_pixel
)
1596 pixel
= f
->output_data
.x
->mouse_pixel
;
1597 if (pixel
== fore_pixel
)
1598 fore_pixel
= f
->output_data
.x
->background_pixel
;
1601 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1602 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1604 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1605 f
->output_data
.x
->cursor_pixel
= pixel
;
1607 if (FRAME_X_WINDOW (f
) != 0)
1610 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1611 f
->output_data
.x
->cursor_pixel
);
1612 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1616 if (FRAME_VISIBLE_P (f
))
1618 x_update_cursor (f
, 0);
1619 x_update_cursor (f
, 1);
1623 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1626 /* Set the border-color of frame F to value described by ARG.
1627 ARG can be a string naming a color.
1628 The border-color is used for the border that is drawn by the X server.
1629 Note that this does not fully take effect if done before
1630 F has an x-window; it must be redone when the window is created.
1632 Note: this is done in two routines because of the way X10 works.
1634 Note: under X11, this is normally the province of the window manager,
1635 and so emacs' border colors may be overridden. */
1638 x_set_border_color (f
, arg
, oldval
)
1640 Lisp_Object arg
, oldval
;
1644 CHECK_STRING (arg
, 0);
1645 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1646 x_set_border_pixel (f
, pix
);
1647 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1650 /* Set the border-color of frame F to pixel value PIX.
1651 Note that this does not fully take effect if done before
1652 F has an x-window. */
1655 x_set_border_pixel (f
, pix
)
1659 unload_color (f
, f
->output_data
.x
->border_pixel
);
1660 f
->output_data
.x
->border_pixel
= pix
;
1662 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1665 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1666 (unsigned long)pix
);
1669 if (FRAME_VISIBLE_P (f
))
1675 x_set_cursor_type (f
, arg
, oldval
)
1677 Lisp_Object arg
, oldval
;
1681 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1682 f
->output_data
.x
->cursor_width
= 2;
1684 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1685 && INTEGERP (XCDR (arg
)))
1687 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1688 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1691 /* Treat anything unknown as "box cursor".
1692 It was bad to signal an error; people have trouble fixing
1693 .Xdefaults with Emacs, when it has something bad in it. */
1694 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1696 /* Make sure the cursor gets redrawn. This is overkill, but how
1697 often do people change cursor types? */
1698 update_mode_lines
++;
1702 x_set_icon_type (f
, arg
, oldval
)
1704 Lisp_Object arg
, oldval
;
1710 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1713 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1718 result
= x_text_icon (f
,
1719 (char *) XSTRING ((!NILP (f
->icon_name
)
1723 result
= x_bitmap_icon (f
, arg
);
1728 error ("No icon window available");
1731 XFlush (FRAME_X_DISPLAY (f
));
1735 /* Return non-nil if frame F wants a bitmap icon. */
1743 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1751 x_set_icon_name (f
, arg
, oldval
)
1753 Lisp_Object arg
, oldval
;
1759 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1762 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1767 if (f
->output_data
.x
->icon_bitmap
!= 0)
1772 result
= x_text_icon (f
,
1773 (char *) XSTRING ((!NILP (f
->icon_name
)
1782 error ("No icon window available");
1785 XFlush (FRAME_X_DISPLAY (f
));
1790 x_set_font (f
, arg
, oldval
)
1792 Lisp_Object arg
, oldval
;
1795 Lisp_Object fontset_name
;
1798 CHECK_STRING (arg
, 1);
1800 fontset_name
= Fquery_fontset (arg
, Qnil
);
1803 result
= (STRINGP (fontset_name
)
1804 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1805 : x_new_font (f
, XSTRING (arg
)->data
));
1808 if (EQ (result
, Qnil
))
1809 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1810 else if (EQ (result
, Qt
))
1811 error ("The characters of the given font have varying widths");
1812 else if (STRINGP (result
))
1814 store_frame_param (f
, Qfont
, result
);
1815 recompute_basic_faces (f
);
1820 do_pending_window_change (0);
1822 /* Don't call `face-set-after-frame-default' when faces haven't been
1823 initialized yet. This is the case when called from
1824 Fx_create_frame. In that case, the X widget or window doesn't
1825 exist either, and we can end up in x_report_frame_params with a
1826 null widget which gives a segfault. */
1827 if (FRAME_FACE_CACHE (f
))
1829 XSETFRAME (frame
, f
);
1830 call1 (Qface_set_after_frame_default
, frame
);
1835 x_set_border_width (f
, arg
, oldval
)
1837 Lisp_Object arg
, oldval
;
1839 CHECK_NUMBER (arg
, 0);
1841 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1844 if (FRAME_X_WINDOW (f
) != 0)
1845 error ("Cannot change the border width of a window");
1847 f
->output_data
.x
->border_width
= XINT (arg
);
1851 x_set_internal_border_width (f
, arg
, oldval
)
1853 Lisp_Object arg
, oldval
;
1855 int old
= f
->output_data
.x
->internal_border_width
;
1857 CHECK_NUMBER (arg
, 0);
1858 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1859 if (f
->output_data
.x
->internal_border_width
< 0)
1860 f
->output_data
.x
->internal_border_width
= 0;
1862 #ifdef USE_X_TOOLKIT
1863 if (f
->output_data
.x
->edit_widget
)
1864 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1867 if (f
->output_data
.x
->internal_border_width
== old
)
1870 if (FRAME_X_WINDOW (f
) != 0)
1872 x_set_window_size (f
, 0, f
->width
, f
->height
);
1873 SET_FRAME_GARBAGED (f
);
1874 do_pending_window_change (0);
1879 x_set_visibility (f
, value
, oldval
)
1881 Lisp_Object value
, oldval
;
1884 XSETFRAME (frame
, f
);
1887 Fmake_frame_invisible (frame
, Qt
);
1888 else if (EQ (value
, Qicon
))
1889 Ficonify_frame (frame
);
1891 Fmake_frame_visible (frame
);
1895 x_set_menu_bar_lines_1 (window
, n
)
1899 struct window
*w
= XWINDOW (window
);
1901 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1902 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1904 /* Handle just the top child in a vertical split. */
1905 if (!NILP (w
->vchild
))
1906 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1908 /* Adjust all children in a horizontal split. */
1909 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1911 w
= XWINDOW (window
);
1912 x_set_menu_bar_lines_1 (window
, n
);
1917 x_set_menu_bar_lines (f
, value
, oldval
)
1919 Lisp_Object value
, oldval
;
1922 #ifndef USE_X_TOOLKIT
1923 int olines
= FRAME_MENU_BAR_LINES (f
);
1926 /* Right now, menu bars don't work properly in minibuf-only frames;
1927 most of the commands try to apply themselves to the minibuffer
1928 frame itself, and get an error because you can't switch buffers
1929 in or split the minibuffer window. */
1930 if (FRAME_MINIBUF_ONLY_P (f
))
1933 if (INTEGERP (value
))
1934 nlines
= XINT (value
);
1938 /* Make sure we redisplay all windows in this frame. */
1939 windows_or_buffers_changed
++;
1941 #ifdef USE_X_TOOLKIT
1942 FRAME_MENU_BAR_LINES (f
) = 0;
1945 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1946 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1947 /* Make sure next redisplay shows the menu bar. */
1948 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1952 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1953 free_frame_menubar (f
);
1954 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1956 f
->output_data
.x
->menubar_widget
= 0;
1958 #else /* not USE_X_TOOLKIT */
1959 FRAME_MENU_BAR_LINES (f
) = nlines
;
1960 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1961 #endif /* not USE_X_TOOLKIT */
1966 /* Set the number of lines used for the tool bar of frame F to VALUE.
1967 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1968 is the old number of tool bar lines. This function changes the
1969 height of all windows on frame F to match the new tool bar height.
1970 The frame's height doesn't change. */
1973 x_set_tool_bar_lines (f
, value
, oldval
)
1975 Lisp_Object value
, oldval
;
1979 /* Use VALUE only if an integer >= 0. */
1980 if (INTEGERP (value
) && XINT (value
) >= 0)
1981 nlines
= XFASTINT (value
);
1985 /* Make sure we redisplay all windows in this frame. */
1986 ++windows_or_buffers_changed
;
1988 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1989 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1990 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
1995 /* Set the foreground color for scroll bars on frame F to VALUE.
1996 VALUE should be a string, a color name. If it isn't a string or
1997 isn't a valid color name, do nothing. OLDVAL is the old value of
1998 the frame parameter. */
2001 x_set_scroll_bar_foreground (f
, value
, oldval
)
2003 Lisp_Object value
, oldval
;
2005 unsigned long pixel
;
2007 if (STRINGP (value
))
2008 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2012 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2013 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2015 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2016 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2018 /* Remove all scroll bars because they have wrong colors. */
2019 if (condemn_scroll_bars_hook
)
2020 (*condemn_scroll_bars_hook
) (f
);
2021 if (judge_scroll_bars_hook
)
2022 (*judge_scroll_bars_hook
) (f
);
2024 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2030 /* Set the background color for scroll bars on frame F to VALUE VALUE
2031 should be a string, a color name. If it isn't a string or isn't a
2032 valid color name, do nothing. OLDVAL is the old value of the frame
2036 x_set_scroll_bar_background (f
, value
, oldval
)
2038 Lisp_Object value
, oldval
;
2040 unsigned long pixel
;
2042 if (STRINGP (value
))
2043 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2047 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2048 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2050 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2051 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2053 /* Remove all scroll bars because they have wrong colors. */
2054 if (condemn_scroll_bars_hook
)
2055 (*condemn_scroll_bars_hook
) (f
);
2056 if (judge_scroll_bars_hook
)
2057 (*judge_scroll_bars_hook
) (f
);
2059 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2065 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2068 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2069 name; if NAME is a string, set F's name to NAME and set
2070 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2072 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2073 suggesting a new name, which lisp code should override; if
2074 F->explicit_name is set, ignore the new name; otherwise, set it. */
2077 x_set_name (f
, name
, explicit)
2082 /* Make sure that requests from lisp code override requests from
2083 Emacs redisplay code. */
2086 /* If we're switching from explicit to implicit, we had better
2087 update the mode lines and thereby update the title. */
2088 if (f
->explicit_name
&& NILP (name
))
2089 update_mode_lines
= 1;
2091 f
->explicit_name
= ! NILP (name
);
2093 else if (f
->explicit_name
)
2096 /* If NAME is nil, set the name to the x_id_name. */
2099 /* Check for no change needed in this very common case
2100 before we do any consing. */
2101 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2102 XSTRING (f
->name
)->data
))
2104 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2107 CHECK_STRING (name
, 0);
2109 /* Don't change the name if it's already NAME. */
2110 if (! NILP (Fstring_equal (name
, f
->name
)))
2115 /* For setting the frame title, the title parameter should override
2116 the name parameter. */
2117 if (! NILP (f
->title
))
2120 if (FRAME_X_WINDOW (f
))
2125 XTextProperty text
, icon
;
2126 Lisp_Object icon_name
;
2128 text
.value
= XSTRING (name
)->data
;
2129 text
.encoding
= XA_STRING
;
2131 text
.nitems
= STRING_BYTES (XSTRING (name
));
2133 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2135 icon
.value
= XSTRING (icon_name
)->data
;
2136 icon
.encoding
= XA_STRING
;
2138 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2139 #ifdef USE_X_TOOLKIT
2140 XSetWMName (FRAME_X_DISPLAY (f
),
2141 XtWindow (f
->output_data
.x
->widget
), &text
);
2142 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2144 #else /* not USE_X_TOOLKIT */
2145 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2146 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2147 #endif /* not USE_X_TOOLKIT */
2149 #else /* not HAVE_X11R4 */
2150 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2151 XSTRING (name
)->data
);
2152 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2153 XSTRING (name
)->data
);
2154 #endif /* not HAVE_X11R4 */
2159 /* This function should be called when the user's lisp code has
2160 specified a name for the frame; the name will override any set by the
2163 x_explicitly_set_name (f
, arg
, oldval
)
2165 Lisp_Object arg
, oldval
;
2167 x_set_name (f
, arg
, 1);
2170 /* This function should be called by Emacs redisplay code to set the
2171 name; names set this way will never override names set by the user's
2174 x_implicitly_set_name (f
, arg
, oldval
)
2176 Lisp_Object arg
, oldval
;
2178 x_set_name (f
, arg
, 0);
2181 /* Change the title of frame F to NAME.
2182 If NAME is nil, use the frame name as the title.
2184 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2185 name; if NAME is a string, set F's name to NAME and set
2186 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2188 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2189 suggesting a new name, which lisp code should override; if
2190 F->explicit_name is set, ignore the new name; otherwise, set it. */
2193 x_set_title (f
, name
, old_name
)
2195 Lisp_Object name
, old_name
;
2197 /* Don't change the title if it's already NAME. */
2198 if (EQ (name
, f
->title
))
2201 update_mode_lines
= 1;
2208 CHECK_STRING (name
, 0);
2210 if (FRAME_X_WINDOW (f
))
2215 XTextProperty text
, icon
;
2216 Lisp_Object icon_name
;
2218 text
.value
= XSTRING (name
)->data
;
2219 text
.encoding
= XA_STRING
;
2221 text
.nitems
= STRING_BYTES (XSTRING (name
));
2223 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2225 icon
.value
= XSTRING (icon_name
)->data
;
2226 icon
.encoding
= XA_STRING
;
2228 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2229 #ifdef USE_X_TOOLKIT
2230 XSetWMName (FRAME_X_DISPLAY (f
),
2231 XtWindow (f
->output_data
.x
->widget
), &text
);
2232 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2234 #else /* not USE_X_TOOLKIT */
2235 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2236 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2237 #endif /* not USE_X_TOOLKIT */
2239 #else /* not HAVE_X11R4 */
2240 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2241 XSTRING (name
)->data
);
2242 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2243 XSTRING (name
)->data
);
2244 #endif /* not HAVE_X11R4 */
2250 x_set_autoraise (f
, arg
, oldval
)
2252 Lisp_Object arg
, oldval
;
2254 f
->auto_raise
= !EQ (Qnil
, arg
);
2258 x_set_autolower (f
, arg
, oldval
)
2260 Lisp_Object arg
, oldval
;
2262 f
->auto_lower
= !EQ (Qnil
, arg
);
2266 x_set_unsplittable (f
, arg
, oldval
)
2268 Lisp_Object arg
, oldval
;
2270 f
->no_split
= !NILP (arg
);
2274 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2276 Lisp_Object arg
, oldval
;
2278 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2279 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2280 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2281 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2283 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2285 ? vertical_scroll_bar_none
2287 ? vertical_scroll_bar_right
2288 : vertical_scroll_bar_left
);
2290 /* We set this parameter before creating the X window for the
2291 frame, so we can get the geometry right from the start.
2292 However, if the window hasn't been created yet, we shouldn't
2293 call x_set_window_size. */
2294 if (FRAME_X_WINDOW (f
))
2295 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2296 do_pending_window_change (0);
2301 x_set_scroll_bar_width (f
, arg
, oldval
)
2303 Lisp_Object arg
, oldval
;
2305 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2309 #ifdef USE_TOOLKIT_SCROLL_BARS
2310 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2311 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2312 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2313 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2315 /* Make the actual width at least 14 pixels and a multiple of a
2317 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2319 /* Use all of that space (aside from required margins) for the
2321 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2324 if (FRAME_X_WINDOW (f
))
2325 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2326 do_pending_window_change (0);
2328 else if (INTEGERP (arg
) && XINT (arg
) > 0
2329 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2331 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2332 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2334 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2335 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2336 if (FRAME_X_WINDOW (f
))
2337 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2340 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2341 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2342 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2347 /* Subroutines of creating an X frame. */
2349 /* Make sure that Vx_resource_name is set to a reasonable value.
2350 Fix it up, or set it to `emacs' if it is too hopeless. */
2353 validate_x_resource_name ()
2356 /* Number of valid characters in the resource name. */
2358 /* Number of invalid characters in the resource name. */
2363 if (!STRINGP (Vx_resource_class
))
2364 Vx_resource_class
= build_string (EMACS_CLASS
);
2366 if (STRINGP (Vx_resource_name
))
2368 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2371 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2373 /* Only letters, digits, - and _ are valid in resource names.
2374 Count the valid characters and count the invalid ones. */
2375 for (i
= 0; i
< len
; i
++)
2378 if (! ((c
>= 'a' && c
<= 'z')
2379 || (c
>= 'A' && c
<= 'Z')
2380 || (c
>= '0' && c
<= '9')
2381 || c
== '-' || c
== '_'))
2388 /* Not a string => completely invalid. */
2389 bad_count
= 5, good_count
= 0;
2391 /* If name is valid already, return. */
2395 /* If name is entirely invalid, or nearly so, use `emacs'. */
2397 || (good_count
== 1 && bad_count
> 0))
2399 Vx_resource_name
= build_string ("emacs");
2403 /* Name is partly valid. Copy it and replace the invalid characters
2404 with underscores. */
2406 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2408 for (i
= 0; i
< len
; i
++)
2410 int c
= XSTRING (new)->data
[i
];
2411 if (! ((c
>= 'a' && c
<= 'z')
2412 || (c
>= 'A' && c
<= 'Z')
2413 || (c
>= '0' && c
<= '9')
2414 || c
== '-' || c
== '_'))
2415 XSTRING (new)->data
[i
] = '_';
2420 extern char *x_get_string_resource ();
2422 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2423 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2424 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2425 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2426 the name specified by the `-name' or `-rn' command-line arguments.\n\
2428 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2429 class, respectively. You must specify both of them or neither.\n\
2430 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2431 and the class is `Emacs.CLASS.SUBCLASS'.")
2432 (attribute
, class, component
, subclass
)
2433 Lisp_Object attribute
, class, component
, subclass
;
2435 register char *value
;
2441 CHECK_STRING (attribute
, 0);
2442 CHECK_STRING (class, 0);
2444 if (!NILP (component
))
2445 CHECK_STRING (component
, 1);
2446 if (!NILP (subclass
))
2447 CHECK_STRING (subclass
, 2);
2448 if (NILP (component
) != NILP (subclass
))
2449 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2451 validate_x_resource_name ();
2453 /* Allocate space for the components, the dots which separate them,
2454 and the final '\0'. Make them big enough for the worst case. */
2455 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2456 + (STRINGP (component
)
2457 ? STRING_BYTES (XSTRING (component
)) : 0)
2458 + STRING_BYTES (XSTRING (attribute
))
2461 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2462 + STRING_BYTES (XSTRING (class))
2463 + (STRINGP (subclass
)
2464 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2467 /* Start with emacs.FRAMENAME for the name (the specific one)
2468 and with `Emacs' for the class key (the general one). */
2469 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2470 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2472 strcat (class_key
, ".");
2473 strcat (class_key
, XSTRING (class)->data
);
2475 if (!NILP (component
))
2477 strcat (class_key
, ".");
2478 strcat (class_key
, XSTRING (subclass
)->data
);
2480 strcat (name_key
, ".");
2481 strcat (name_key
, XSTRING (component
)->data
);
2484 strcat (name_key
, ".");
2485 strcat (name_key
, XSTRING (attribute
)->data
);
2487 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2488 name_key
, class_key
);
2490 if (value
!= (char *) 0)
2491 return build_string (value
);
2496 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2499 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2500 struct x_display_info
*dpyinfo
;
2501 Lisp_Object attribute
, class, component
, subclass
;
2503 register char *value
;
2509 CHECK_STRING (attribute
, 0);
2510 CHECK_STRING (class, 0);
2512 if (!NILP (component
))
2513 CHECK_STRING (component
, 1);
2514 if (!NILP (subclass
))
2515 CHECK_STRING (subclass
, 2);
2516 if (NILP (component
) != NILP (subclass
))
2517 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2519 validate_x_resource_name ();
2521 /* Allocate space for the components, the dots which separate them,
2522 and the final '\0'. Make them big enough for the worst case. */
2523 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2524 + (STRINGP (component
)
2525 ? STRING_BYTES (XSTRING (component
)) : 0)
2526 + STRING_BYTES (XSTRING (attribute
))
2529 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2530 + STRING_BYTES (XSTRING (class))
2531 + (STRINGP (subclass
)
2532 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2535 /* Start with emacs.FRAMENAME for the name (the specific one)
2536 and with `Emacs' for the class key (the general one). */
2537 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2538 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2540 strcat (class_key
, ".");
2541 strcat (class_key
, XSTRING (class)->data
);
2543 if (!NILP (component
))
2545 strcat (class_key
, ".");
2546 strcat (class_key
, XSTRING (subclass
)->data
);
2548 strcat (name_key
, ".");
2549 strcat (name_key
, XSTRING (component
)->data
);
2552 strcat (name_key
, ".");
2553 strcat (name_key
, XSTRING (attribute
)->data
);
2555 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2557 if (value
!= (char *) 0)
2558 return build_string (value
);
2563 /* Used when C code wants a resource value. */
2566 x_get_resource_string (attribute
, class)
2567 char *attribute
, *class;
2571 struct frame
*sf
= SELECTED_FRAME ();
2573 /* Allocate space for the components, the dots which separate them,
2574 and the final '\0'. */
2575 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2576 + strlen (attribute
) + 2);
2577 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2578 + strlen (class) + 2);
2580 sprintf (name_key
, "%s.%s",
2581 XSTRING (Vinvocation_name
)->data
,
2583 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2585 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2586 name_key
, class_key
);
2589 /* Types we might convert a resource string into. */
2599 /* Return the value of parameter PARAM.
2601 First search ALIST, then Vdefault_frame_alist, then the X defaults
2602 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2604 Convert the resource to the type specified by desired_type.
2606 If no default is specified, return Qunbound. If you call
2607 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2608 and don't let it get stored in any Lisp-visible variables! */
2611 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2612 struct x_display_info
*dpyinfo
;
2613 Lisp_Object alist
, param
;
2616 enum resource_types type
;
2618 register Lisp_Object tem
;
2620 tem
= Fassq (param
, alist
);
2622 tem
= Fassq (param
, Vdefault_frame_alist
);
2628 tem
= display_x_get_resource (dpyinfo
,
2629 build_string (attribute
),
2630 build_string (class),
2638 case RES_TYPE_NUMBER
:
2639 return make_number (atoi (XSTRING (tem
)->data
));
2641 case RES_TYPE_FLOAT
:
2642 return make_float (atof (XSTRING (tem
)->data
));
2644 case RES_TYPE_BOOLEAN
:
2645 tem
= Fdowncase (tem
);
2646 if (!strcmp (XSTRING (tem
)->data
, "on")
2647 || !strcmp (XSTRING (tem
)->data
, "true"))
2652 case RES_TYPE_STRING
:
2655 case RES_TYPE_SYMBOL
:
2656 /* As a special case, we map the values `true' and `on'
2657 to Qt, and `false' and `off' to Qnil. */
2660 lower
= Fdowncase (tem
);
2661 if (!strcmp (XSTRING (lower
)->data
, "on")
2662 || !strcmp (XSTRING (lower
)->data
, "true"))
2664 else if (!strcmp (XSTRING (lower
)->data
, "off")
2665 || !strcmp (XSTRING (lower
)->data
, "false"))
2668 return Fintern (tem
, Qnil
);
2681 /* Like x_get_arg, but also record the value in f->param_alist. */
2684 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2686 Lisp_Object alist
, param
;
2689 enum resource_types type
;
2693 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2694 attribute
, class, type
);
2696 store_frame_param (f
, param
, value
);
2701 /* Record in frame F the specified or default value according to ALIST
2702 of the parameter named PROP (a Lisp symbol).
2703 If no value is specified for PROP, look for an X default for XPROP
2704 on the frame named NAME.
2705 If that is not found either, use the value DEFLT. */
2708 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2715 enum resource_types type
;
2719 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2720 if (EQ (tem
, Qunbound
))
2722 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2727 /* Record in frame F the specified or default value according to ALIST
2728 of the parameter named PROP (a Lisp symbol). If no value is
2729 specified for PROP, look for an X default for XPROP on the frame
2730 named NAME. If that is not found either, use the value DEFLT. */
2733 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2742 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2745 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2746 if (EQ (tem
, Qunbound
))
2748 #ifdef USE_TOOLKIT_SCROLL_BARS
2750 /* See if an X resource for the scroll bar color has been
2752 tem
= display_x_get_resource (dpyinfo
,
2753 build_string (foreground_p
2757 build_string ("verticalScrollBar"),
2761 /* If nothing has been specified, scroll bars will use a
2762 toolkit-dependent default. Because these defaults are
2763 difficult to get at without actually creating a scroll
2764 bar, use nil to indicate that no color has been
2769 #else /* not USE_TOOLKIT_SCROLL_BARS */
2773 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2776 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2782 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2783 "Parse an X-style geometry string STRING.\n\
2784 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2785 The properties returned may include `top', `left', `height', and `width'.\n\
2786 The value of `left' or `top' may be an integer,\n\
2787 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2788 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2793 unsigned int width
, height
;
2796 CHECK_STRING (string
, 0);
2798 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2799 &x
, &y
, &width
, &height
);
2802 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2803 error ("Must specify both x and y position, or neither");
2807 if (geometry
& XValue
)
2809 Lisp_Object element
;
2811 if (x
>= 0 && (geometry
& XNegative
))
2812 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2813 else if (x
< 0 && ! (geometry
& XNegative
))
2814 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2816 element
= Fcons (Qleft
, make_number (x
));
2817 result
= Fcons (element
, result
);
2820 if (geometry
& YValue
)
2822 Lisp_Object element
;
2824 if (y
>= 0 && (geometry
& YNegative
))
2825 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2826 else if (y
< 0 && ! (geometry
& YNegative
))
2827 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2829 element
= Fcons (Qtop
, make_number (y
));
2830 result
= Fcons (element
, result
);
2833 if (geometry
& WidthValue
)
2834 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2835 if (geometry
& HeightValue
)
2836 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2841 /* Calculate the desired size and position of this window,
2842 and return the flags saying which aspects were specified.
2844 This function does not make the coordinates positive. */
2846 #define DEFAULT_ROWS 40
2847 #define DEFAULT_COLS 80
2850 x_figure_window_size (f
, parms
)
2854 register Lisp_Object tem0
, tem1
, tem2
;
2855 long window_prompting
= 0;
2856 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2858 /* Default values if we fall through.
2859 Actually, if that happens we should get
2860 window manager prompting. */
2861 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2862 f
->height
= DEFAULT_ROWS
;
2863 /* Window managers expect that if program-specified
2864 positions are not (0,0), they're intentional, not defaults. */
2865 f
->output_data
.x
->top_pos
= 0;
2866 f
->output_data
.x
->left_pos
= 0;
2868 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2869 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2870 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2871 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2873 if (!EQ (tem0
, Qunbound
))
2875 CHECK_NUMBER (tem0
, 0);
2876 f
->height
= XINT (tem0
);
2878 if (!EQ (tem1
, Qunbound
))
2880 CHECK_NUMBER (tem1
, 0);
2881 SET_FRAME_WIDTH (f
, XINT (tem1
));
2883 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2884 window_prompting
|= USSize
;
2886 window_prompting
|= PSize
;
2889 f
->output_data
.x
->vertical_scroll_bar_extra
2890 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2892 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2893 f
->output_data
.x
->flags_areas_extra
2894 = FRAME_FLAGS_AREA_WIDTH (f
);
2895 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2896 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2898 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2899 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2900 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2901 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2903 if (EQ (tem0
, Qminus
))
2905 f
->output_data
.x
->top_pos
= 0;
2906 window_prompting
|= YNegative
;
2908 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2909 && CONSP (XCDR (tem0
))
2910 && INTEGERP (XCAR (XCDR (tem0
))))
2912 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2913 window_prompting
|= YNegative
;
2915 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2916 && CONSP (XCDR (tem0
))
2917 && INTEGERP (XCAR (XCDR (tem0
))))
2919 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2921 else if (EQ (tem0
, Qunbound
))
2922 f
->output_data
.x
->top_pos
= 0;
2925 CHECK_NUMBER (tem0
, 0);
2926 f
->output_data
.x
->top_pos
= XINT (tem0
);
2927 if (f
->output_data
.x
->top_pos
< 0)
2928 window_prompting
|= YNegative
;
2931 if (EQ (tem1
, Qminus
))
2933 f
->output_data
.x
->left_pos
= 0;
2934 window_prompting
|= XNegative
;
2936 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2937 && CONSP (XCDR (tem1
))
2938 && INTEGERP (XCAR (XCDR (tem1
))))
2940 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2941 window_prompting
|= XNegative
;
2943 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2944 && CONSP (XCDR (tem1
))
2945 && INTEGERP (XCAR (XCDR (tem1
))))
2947 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2949 else if (EQ (tem1
, Qunbound
))
2950 f
->output_data
.x
->left_pos
= 0;
2953 CHECK_NUMBER (tem1
, 0);
2954 f
->output_data
.x
->left_pos
= XINT (tem1
);
2955 if (f
->output_data
.x
->left_pos
< 0)
2956 window_prompting
|= XNegative
;
2959 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2960 window_prompting
|= USPosition
;
2962 window_prompting
|= PPosition
;
2965 return window_prompting
;
2968 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2971 XSetWMProtocols (dpy
, w
, protocols
, count
)
2978 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2979 if (prop
== None
) return False
;
2980 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2981 (unsigned char *) protocols
, count
);
2984 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2986 #ifdef USE_X_TOOLKIT
2988 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2989 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2990 already be present because of the toolkit (Motif adds some of them,
2991 for example, but Xt doesn't). */
2994 hack_wm_protocols (f
, widget
)
2998 Display
*dpy
= XtDisplay (widget
);
2999 Window w
= XtWindow (widget
);
3000 int need_delete
= 1;
3006 Atom type
, *atoms
= 0;
3008 unsigned long nitems
= 0;
3009 unsigned long bytes_after
;
3011 if ((XGetWindowProperty (dpy
, w
,
3012 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3013 (long)0, (long)100, False
, XA_ATOM
,
3014 &type
, &format
, &nitems
, &bytes_after
,
3015 (unsigned char **) &atoms
)
3017 && format
== 32 && type
== XA_ATOM
)
3021 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3023 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3025 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3028 if (atoms
) XFree ((char *) atoms
);
3034 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3036 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3038 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3040 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3041 XA_ATOM
, 32, PropModeAppend
,
3042 (unsigned char *) props
, count
);
3049 /* Create input method and input context for frame F. Set FRAME_XIM
3050 (F) and FRAME_XIC (F). */
3060 #ifndef X_I18N_INHIBITED
3065 XIMStyle input_style
= XIMPreeditNothing
| XIMStatusNothing
;
3068 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3072 if (XGetIMValues (xim
, XNQueryInputStyle
, &styles
, NULL
)
3075 /* Input method doesn't support any input style. */
3080 /* See if input_style is supported. Give up if it isn't. */
3081 n
= styles
->count_styles
;
3082 for (i
= 0; i
< n
; ++i
)
3083 if (styles
->supported_styles
[i
] == input_style
)
3093 /* Create the input context. */
3094 xic
= XCreateIC (xim
,
3095 XNInputStyle
, input_style
,
3096 XNClientWindow
, FRAME_X_WINDOW(f
),
3097 XNFocusWindow
, FRAME_X_WINDOW(f
),
3106 FRAME_XIM (f
) = xim
;
3107 FRAME_XIC (f
) = xic
;
3109 #endif /* X_I18N_INHIBITED */
3110 #endif /* HAVE_X_I18N */
3114 #ifdef USE_X_TOOLKIT
3116 /* Create and set up the X widget for frame F. */
3119 x_window (f
, window_prompting
, minibuffer_only
)
3121 long window_prompting
;
3122 int minibuffer_only
;
3124 XClassHint class_hints
;
3125 XSetWindowAttributes attributes
;
3126 unsigned long attribute_mask
;
3128 Widget shell_widget
;
3130 Widget frame_widget
;
3136 /* Use the resource name as the top-level widget name
3137 for looking up resources. Make a non-Lisp copy
3138 for the window manager, so GC relocation won't bother it.
3140 Elsewhere we specify the window name for the window manager. */
3143 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3144 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3145 strcpy (f
->namebuf
, str
);
3149 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3150 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3151 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3152 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3153 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3154 applicationShellWidgetClass
,
3155 FRAME_X_DISPLAY (f
), al
, ac
);
3157 f
->output_data
.x
->widget
= shell_widget
;
3158 /* maybe_set_screen_title_format (shell_widget); */
3160 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3161 (widget_value
*) NULL
,
3162 shell_widget
, False
,
3165 (lw_callback
) NULL
);
3167 f
->output_data
.x
->column_widget
= pane_widget
;
3169 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3170 the emacs screen when changing menubar. This reduces flickering. */
3173 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3174 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3175 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3176 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3177 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3178 frame_widget
= XtCreateWidget (f
->namebuf
,
3180 pane_widget
, al
, ac
);
3182 f
->output_data
.x
->edit_widget
= frame_widget
;
3184 XtManageChild (frame_widget
);
3186 /* Do some needed geometry management. */
3189 char *tem
, shell_position
[32];
3192 int extra_borders
= 0;
3194 = (f
->output_data
.x
->menubar_widget
3195 ? (f
->output_data
.x
->menubar_widget
->core
.height
3196 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3199 #if 0 /* Experimentally, we now get the right results
3200 for -geometry -0-0 without this. 24 Aug 96, rms. */
3201 if (FRAME_EXTERNAL_MENU_BAR (f
))
3204 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3205 menubar_size
+= ibw
;
3209 f
->output_data
.x
->menubar_height
= menubar_size
;
3212 /* Motif seems to need this amount added to the sizes
3213 specified for the shell widget. The Athena/Lucid widgets don't.
3214 Both conclusions reached experimentally. -- rms. */
3215 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3216 &extra_borders
, NULL
);
3220 /* Convert our geometry parameters into a geometry string
3222 Note that we do not specify here whether the position
3223 is a user-specified or program-specified one.
3224 We pass that information later, in x_wm_set_size_hints. */
3226 int left
= f
->output_data
.x
->left_pos
;
3227 int xneg
= window_prompting
& XNegative
;
3228 int top
= f
->output_data
.x
->top_pos
;
3229 int yneg
= window_prompting
& YNegative
;
3235 if (window_prompting
& USPosition
)
3236 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3237 PIXEL_WIDTH (f
) + extra_borders
,
3238 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3239 (xneg
? '-' : '+'), left
,
3240 (yneg
? '-' : '+'), top
);
3242 sprintf (shell_position
, "=%dx%d",
3243 PIXEL_WIDTH (f
) + extra_borders
,
3244 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3247 len
= strlen (shell_position
) + 1;
3248 /* We don't free this because we don't know whether
3249 it is safe to free it while the frame exists.
3250 It isn't worth the trouble of arranging to free it
3251 when the frame is deleted. */
3252 tem
= (char *) xmalloc (len
);
3253 strncpy (tem
, shell_position
, len
);
3254 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3255 XtSetValues (shell_widget
, al
, ac
);
3258 XtManageChild (pane_widget
);
3259 XtRealizeWidget (shell_widget
);
3261 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3263 validate_x_resource_name ();
3265 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3266 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3267 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3270 f
->output_data
.x
->wm_hints
.input
= True
;
3271 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3272 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3273 &f
->output_data
.x
->wm_hints
);
3275 hack_wm_protocols (f
, shell_widget
);
3278 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3281 /* Do a stupid property change to force the server to generate a
3282 PropertyNotify event so that the event_stream server timestamp will
3283 be initialized to something relevant to the time we created the window.
3285 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3286 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3287 XA_ATOM
, 32, PropModeAppend
,
3288 (unsigned char*) NULL
, 0);
3290 /* Make all the standard events reach the Emacs frame. */
3291 attributes
.event_mask
= STANDARD_EVENT_SET
;
3292 attribute_mask
= CWEventMask
;
3293 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3294 attribute_mask
, &attributes
);
3296 XtMapWidget (frame_widget
);
3298 /* x_set_name normally ignores requests to set the name if the
3299 requested name is the same as the current name. This is the one
3300 place where that assumption isn't correct; f->name is set, but
3301 the X server hasn't been told. */
3304 int explicit = f
->explicit_name
;
3306 f
->explicit_name
= 0;
3309 x_set_name (f
, name
, explicit);
3312 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3313 f
->output_data
.x
->text_cursor
);
3317 /* This is a no-op, except under Motif. Make sure main areas are
3318 set to something reasonable, in case we get an error later. */
3319 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3322 #else /* not USE_X_TOOLKIT */
3324 /* Create and set up the X window for frame F. */
3331 XClassHint class_hints
;
3332 XSetWindowAttributes attributes
;
3333 unsigned long attribute_mask
;
3335 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3336 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3337 attributes
.bit_gravity
= StaticGravity
;
3338 attributes
.backing_store
= NotUseful
;
3339 attributes
.save_under
= True
;
3340 attributes
.event_mask
= STANDARD_EVENT_SET
;
3341 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3343 | CWBackingStore
| CWSaveUnder
3349 = XCreateWindow (FRAME_X_DISPLAY (f
),
3350 f
->output_data
.x
->parent_desc
,
3351 f
->output_data
.x
->left_pos
,
3352 f
->output_data
.x
->top_pos
,
3353 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3354 f
->output_data
.x
->border_width
,
3355 CopyFromParent
, /* depth */
3356 InputOutput
, /* class */
3357 FRAME_X_DISPLAY_INFO (f
)->visual
,
3358 attribute_mask
, &attributes
);
3360 validate_x_resource_name ();
3362 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3363 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3364 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3366 /* The menubar is part of the ordinary display;
3367 it does not count in addition to the height of the window. */
3368 f
->output_data
.x
->menubar_height
= 0;
3370 /* This indicates that we use the "Passive Input" input model.
3371 Unless we do this, we don't get the Focus{In,Out} events that we
3372 need to draw the cursor correctly. Accursed bureaucrats.
3373 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3375 f
->output_data
.x
->wm_hints
.input
= True
;
3376 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3377 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3378 &f
->output_data
.x
->wm_hints
);
3379 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3381 /* Request "save yourself" and "delete window" commands from wm. */
3384 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3385 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3386 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3389 /* x_set_name normally ignores requests to set the name if the
3390 requested name is the same as the current name. This is the one
3391 place where that assumption isn't correct; f->name is set, but
3392 the X server hasn't been told. */
3395 int explicit = f
->explicit_name
;
3397 f
->explicit_name
= 0;
3400 x_set_name (f
, name
, explicit);
3403 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3404 f
->output_data
.x
->text_cursor
);
3408 if (FRAME_X_WINDOW (f
) == 0)
3409 error ("Unable to create window");
3412 #endif /* not USE_X_TOOLKIT */
3414 /* Handle the icon stuff for this window. Perhaps later we might
3415 want an x_set_icon_position which can be called interactively as
3423 Lisp_Object icon_x
, icon_y
;
3424 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3426 /* Set the position of the icon. Note that twm groups all
3427 icons in an icon window. */
3428 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3429 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3430 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3432 CHECK_NUMBER (icon_x
, 0);
3433 CHECK_NUMBER (icon_y
, 0);
3435 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3436 error ("Both left and top icon corners of icon must be specified");
3440 if (! EQ (icon_x
, Qunbound
))
3441 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3443 /* Start up iconic or window? */
3444 x_wm_set_window_state
3445 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3450 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3457 /* Make the GC's needed for this window, setting the
3458 background, border and mouse colors; also create the
3459 mouse cursor and the gray border tile. */
3461 static char cursor_bits
[] =
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,
3466 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3473 XGCValues gc_values
;
3477 /* Create the GC's of this frame.
3478 Note that many default values are used. */
3481 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3482 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3483 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3484 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3485 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3487 GCLineWidth
| GCFont
3488 | GCForeground
| GCBackground
,
3491 /* Reverse video style. */
3492 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3493 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3494 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3496 GCFont
| GCForeground
| GCBackground
3500 /* Cursor has cursor-color background, background-color foreground. */
3501 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3502 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3503 gc_values
.fill_style
= FillOpaqueStippled
;
3505 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3506 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3507 cursor_bits
, 16, 16);
3508 f
->output_data
.x
->cursor_gc
3509 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3510 (GCFont
| GCForeground
| GCBackground
3511 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3515 f
->output_data
.x
->white_relief
.gc
= 0;
3516 f
->output_data
.x
->black_relief
.gc
= 0;
3518 /* Create the gray border tile used when the pointer is not in
3519 the frame. Since this depends on the frame's pixel values,
3520 this must be done on a per-frame basis. */
3521 f
->output_data
.x
->border_tile
3522 = (XCreatePixmapFromBitmapData
3523 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3524 gray_bits
, gray_width
, gray_height
,
3525 f
->output_data
.x
->foreground_pixel
,
3526 f
->output_data
.x
->background_pixel
,
3527 DefaultDepth (FRAME_X_DISPLAY (f
),
3528 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3533 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3535 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3536 Returns an Emacs frame object.\n\
3537 ALIST is an alist of frame parameters.\n\
3538 If the parameters specify that the frame should not have a minibuffer,\n\
3539 and do not specify a specific minibuffer window to use,\n\
3540 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3541 be shared by the new frame.\n\
3543 This function is an internal primitive--use `make-frame' instead.")
3548 Lisp_Object frame
, tem
;
3550 int minibuffer_only
= 0;
3551 long window_prompting
= 0;
3553 int count
= specpdl_ptr
- specpdl
;
3554 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3555 Lisp_Object display
;
3556 struct x_display_info
*dpyinfo
= NULL
;
3562 /* Use this general default value to start with
3563 until we know if this frame has a specified name. */
3564 Vx_resource_name
= Vinvocation_name
;
3566 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3567 if (EQ (display
, Qunbound
))
3569 dpyinfo
= check_x_display_info (display
);
3571 kb
= dpyinfo
->kboard
;
3573 kb
= &the_only_kboard
;
3576 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3578 && ! EQ (name
, Qunbound
)
3580 error ("Invalid frame name--not a string or nil");
3583 Vx_resource_name
= name
;
3585 /* See if parent window is specified. */
3586 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3587 if (EQ (parent
, Qunbound
))
3589 if (! NILP (parent
))
3590 CHECK_NUMBER (parent
, 0);
3592 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3593 /* No need to protect DISPLAY because that's not used after passing
3594 it to make_frame_without_minibuffer. */
3596 GCPRO4 (parms
, parent
, name
, frame
);
3597 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3599 if (EQ (tem
, Qnone
) || NILP (tem
))
3600 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3601 else if (EQ (tem
, Qonly
))
3603 f
= make_minibuffer_frame ();
3604 minibuffer_only
= 1;
3606 else if (WINDOWP (tem
))
3607 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3611 XSETFRAME (frame
, f
);
3613 /* Note that X Windows does support scroll bars. */
3614 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3616 f
->output_method
= output_x_window
;
3617 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3618 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3619 f
->output_data
.x
->icon_bitmap
= -1;
3620 f
->output_data
.x
->fontset
= -1;
3621 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3622 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3625 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3627 if (! STRINGP (f
->icon_name
))
3628 f
->icon_name
= Qnil
;
3630 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3632 FRAME_KBOARD (f
) = kb
;
3635 /* Specify the parent under which to make this X window. */
3639 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3640 f
->output_data
.x
->explicit_parent
= 1;
3644 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3645 f
->output_data
.x
->explicit_parent
= 0;
3648 /* Set the name; the functions to which we pass f expect the name to
3650 if (EQ (name
, Qunbound
) || NILP (name
))
3652 f
->name
= build_string (dpyinfo
->x_id_name
);
3653 f
->explicit_name
= 0;
3658 f
->explicit_name
= 1;
3659 /* use the frame's title when getting resources for this frame. */
3660 specbind (Qx_resource_name
, name
);
3663 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3664 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3665 fs_register_fontset (f
, XCAR (tem
));
3667 /* Extract the window parameters from the supplied values
3668 that are needed to determine window geometry. */
3672 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3675 /* First, try whatever font the caller has specified. */
3678 tem
= Fquery_fontset (font
, Qnil
);
3680 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3682 font
= x_new_font (f
, XSTRING (font
)->data
);
3685 /* Try out a font which we hope has bold and italic variations. */
3686 if (!STRINGP (font
))
3687 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3688 if (!STRINGP (font
))
3689 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3690 if (! STRINGP (font
))
3691 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3692 if (! STRINGP (font
))
3693 /* This was formerly the first thing tried, but it finds too many fonts
3694 and takes too long. */
3695 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3696 /* If those didn't work, look for something which will at least work. */
3697 if (! STRINGP (font
))
3698 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3700 if (! STRINGP (font
))
3701 font
= build_string ("fixed");
3703 x_default_parameter (f
, parms
, Qfont
, font
,
3704 "font", "Font", RES_TYPE_STRING
);
3708 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3709 whereby it fails to get any font. */
3710 xlwmenu_default_font
= f
->output_data
.x
->font
;
3713 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3714 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3716 /* This defaults to 2 in order to match xterm. We recognize either
3717 internalBorderWidth or internalBorder (which is what xterm calls
3719 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3723 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3724 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3725 if (! EQ (value
, Qunbound
))
3726 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3729 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3730 "internalBorderWidth", "internalBorderWidth",
3732 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3733 "verticalScrollBars", "ScrollBars",
3736 /* Also do the stuff which must be set before the window exists. */
3737 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3738 "foreground", "Foreground", RES_TYPE_STRING
);
3739 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3740 "background", "Background", RES_TYPE_STRING
);
3741 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3742 "pointerColor", "Foreground", RES_TYPE_STRING
);
3743 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3744 "cursorColor", "Foreground", RES_TYPE_STRING
);
3745 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3746 "borderColor", "BorderColor", RES_TYPE_STRING
);
3747 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3748 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3750 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3751 "scrollBarForeground",
3752 "ScrollBarForeground", 1);
3753 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3754 "scrollBarBackground",
3755 "ScrollBarBackground", 0);
3757 /* Init faces before x_default_parameter is called for scroll-bar
3758 parameters because that function calls x_set_scroll_bar_width,
3759 which calls change_frame_size, which calls Fset_window_buffer,
3760 which runs hooks, which call Fvertical_motion. At the end, we
3761 end up in init_iterator with a null face cache, which should not
3763 init_frame_faces (f
);
3765 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3766 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3767 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3768 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3769 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3770 "bufferPredicate", "BufferPredicate",
3772 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3773 "title", "Title", RES_TYPE_STRING
);
3775 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3776 window_prompting
= x_figure_window_size (f
, parms
);
3778 if (window_prompting
& XNegative
)
3780 if (window_prompting
& YNegative
)
3781 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3783 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3787 if (window_prompting
& YNegative
)
3788 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3790 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3793 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3795 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3796 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3798 /* Create the X widget or window. Add the tool-bar height to the
3799 initial frame height so that the user gets a text display area of
3800 the size he specified with -g or via .Xdefaults. Later changes
3801 of the tool-bar height don't change the frame size. This is done
3802 so that users can create tall Emacs frames without having to
3803 guess how tall the tool-bar will get. */
3804 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3806 #ifdef USE_X_TOOLKIT
3807 x_window (f
, window_prompting
, minibuffer_only
);
3815 /* Now consider the frame official. */
3816 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3817 Vframe_list
= Fcons (frame
, Vframe_list
);
3819 /* We need to do this after creating the X window, so that the
3820 icon-creation functions can say whose icon they're describing. */
3821 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3822 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3824 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3825 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3826 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3827 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3828 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3829 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3830 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3831 "scrollBarWidth", "ScrollBarWidth",
3834 /* Dimensions, especially f->height, must be done via change_frame_size.
3835 Change will not be effected unless different from the current
3840 SET_FRAME_WIDTH (f
, 0);
3841 change_frame_size (f
, height
, width
, 1, 0, 0);
3843 /* Set up faces after all frame parameters are known. */
3844 call1 (Qface_set_after_frame_default
, frame
);
3846 #ifdef USE_X_TOOLKIT
3847 /* Create the menu bar. */
3848 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3850 /* If this signals an error, we haven't set size hints for the
3851 frame and we didn't make it visible. */
3852 initialize_frame_menubar (f
);
3854 /* This is a no-op, except under Motif where it arranges the
3855 main window for the widgets on it. */
3856 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3857 f
->output_data
.x
->menubar_widget
,
3858 f
->output_data
.x
->edit_widget
);
3860 #endif /* USE_X_TOOLKIT */
3862 /* Tell the server what size and position, etc, we want, and how
3863 badly we want them. This should be done after we have the menu
3864 bar so that its size can be taken into account. */
3866 x_wm_set_size_hint (f
, window_prompting
, 0);
3869 /* Make the window appear on the frame and enable display, unless
3870 the caller says not to. However, with explicit parent, Emacs
3871 cannot control visibility, so don't try. */
3872 if (! f
->output_data
.x
->explicit_parent
)
3874 Lisp_Object visibility
;
3876 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3878 if (EQ (visibility
, Qunbound
))
3881 if (EQ (visibility
, Qicon
))
3882 x_iconify_frame (f
);
3883 else if (! NILP (visibility
))
3884 x_make_frame_visible (f
);
3886 /* Must have been Qnil. */
3891 return unbind_to (count
, frame
);
3894 /* FRAME is used only to get a handle on the X display. We don't pass the
3895 display info directly because we're called from frame.c, which doesn't
3896 know about that structure. */
3899 x_get_focus_frame (frame
)
3900 struct frame
*frame
;
3902 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3904 if (! dpyinfo
->x_focus_frame
)
3907 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3912 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
3913 "Internal function called by `color-defined-p', which see.")
3915 Lisp_Object color
, frame
;
3918 FRAME_PTR f
= check_x_frame (frame
);
3920 CHECK_STRING (color
, 1);
3922 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3928 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
3929 "Internal function called by `color-values', which see.")
3931 Lisp_Object color
, frame
;
3934 FRAME_PTR f
= check_x_frame (frame
);
3936 CHECK_STRING (color
, 1);
3938 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3942 rgb
[0] = make_number (foo
.red
);
3943 rgb
[1] = make_number (foo
.green
);
3944 rgb
[2] = make_number (foo
.blue
);
3945 return Flist (3, rgb
);
3951 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
3952 "Internal function called by `display-color-p', which see.")
3954 Lisp_Object display
;
3956 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3958 if (dpyinfo
->n_planes
<= 2)
3961 switch (dpyinfo
->visual
->class)
3974 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3976 "Return t if the X display supports shades of gray.\n\
3977 Note that color displays do support shades of gray.\n\
3978 The optional argument DISPLAY specifies which display to ask about.\n\
3979 DISPLAY should be either a frame or a display name (a string).\n\
3980 If omitted or nil, that stands for the selected frame's display.")
3982 Lisp_Object display
;
3984 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3986 if (dpyinfo
->n_planes
<= 1)
3989 switch (dpyinfo
->visual
->class)
4004 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4006 "Returns the width in pixels of the X display DISPLAY.\n\
4007 The optional argument DISPLAY specifies which display to ask about.\n\
4008 DISPLAY should be either a frame or a display name (a string).\n\
4009 If omitted or nil, that stands for the selected frame's display.")
4011 Lisp_Object display
;
4013 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4015 return make_number (dpyinfo
->width
);
4018 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4019 Sx_display_pixel_height
, 0, 1, 0,
4020 "Returns the height in pixels of the X display DISPLAY.\n\
4021 The optional argument DISPLAY specifies which display to ask about.\n\
4022 DISPLAY should be either a frame or a display name (a string).\n\
4023 If omitted or nil, that stands for the selected frame's display.")
4025 Lisp_Object display
;
4027 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4029 return make_number (dpyinfo
->height
);
4032 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4034 "Returns the number of bitplanes of the X display DISPLAY.\n\
4035 The optional argument DISPLAY specifies which display to ask about.\n\
4036 DISPLAY should be either a frame or a display name (a string).\n\
4037 If omitted or nil, that stands for the selected frame's display.")
4039 Lisp_Object display
;
4041 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4043 return make_number (dpyinfo
->n_planes
);
4046 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4048 "Returns the number of color cells of the X display DISPLAY.\n\
4049 The optional argument DISPLAY specifies which display to ask about.\n\
4050 DISPLAY should be either a frame or a display name (a string).\n\
4051 If omitted or nil, that stands for the selected frame's display.")
4053 Lisp_Object display
;
4055 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4057 return make_number (DisplayCells (dpyinfo
->display
,
4058 XScreenNumberOfScreen (dpyinfo
->screen
)));
4061 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4062 Sx_server_max_request_size
,
4064 "Returns the maximum request size of the X server of display DISPLAY.\n\
4065 The optional argument DISPLAY specifies which display to ask about.\n\
4066 DISPLAY should be either a frame or a display name (a string).\n\
4067 If omitted or nil, that stands for the selected frame's display.")
4069 Lisp_Object display
;
4071 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4073 return make_number (MAXREQUEST (dpyinfo
->display
));
4076 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4077 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4078 The optional argument DISPLAY specifies which display to ask about.\n\
4079 DISPLAY should be either a frame or a display name (a string).\n\
4080 If omitted or nil, that stands for the selected frame's display.")
4082 Lisp_Object display
;
4084 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4085 char *vendor
= ServerVendor (dpyinfo
->display
);
4087 if (! vendor
) vendor
= "";
4088 return build_string (vendor
);
4091 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4092 "Returns the version numbers of the X server of display DISPLAY.\n\
4093 The value is a list of three integers: the major and minor\n\
4094 version numbers of the X Protocol in use, and the vendor-specific release\n\
4095 number. See also the function `x-server-vendor'.\n\n\
4096 The optional argument DISPLAY specifies which display to ask about.\n\
4097 DISPLAY should be either a frame or a display name (a string).\n\
4098 If omitted or nil, that stands for the selected frame's display.")
4100 Lisp_Object display
;
4102 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4103 Display
*dpy
= dpyinfo
->display
;
4105 return Fcons (make_number (ProtocolVersion (dpy
)),
4106 Fcons (make_number (ProtocolRevision (dpy
)),
4107 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4110 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4111 "Returns the number of screens on the X server of display DISPLAY.\n\
4112 The optional argument DISPLAY specifies which display to ask about.\n\
4113 DISPLAY should be either a frame or a display name (a string).\n\
4114 If omitted or nil, that stands for the selected frame's display.")
4116 Lisp_Object display
;
4118 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4120 return make_number (ScreenCount (dpyinfo
->display
));
4123 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4124 "Returns the height in millimeters of the X display DISPLAY.\n\
4125 The optional argument DISPLAY specifies which display to ask about.\n\
4126 DISPLAY should be either a frame or a display name (a string).\n\
4127 If omitted or nil, that stands for the selected frame's display.")
4129 Lisp_Object display
;
4131 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4133 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4136 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4137 "Returns the width in millimeters of the X display DISPLAY.\n\
4138 The optional argument DISPLAY specifies which display to ask about.\n\
4139 DISPLAY should be either a frame or a display name (a string).\n\
4140 If omitted or nil, that stands for the selected frame's display.")
4142 Lisp_Object display
;
4144 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4146 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4149 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4150 Sx_display_backing_store
, 0, 1, 0,
4151 "Returns an indication of whether X display DISPLAY does backing store.\n\
4152 The value may be `always', `when-mapped', or `not-useful'.\n\
4153 The optional argument DISPLAY specifies which display to ask about.\n\
4154 DISPLAY should be either a frame or a display name (a string).\n\
4155 If omitted or nil, that stands for the selected frame's display.")
4157 Lisp_Object display
;
4159 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4161 switch (DoesBackingStore (dpyinfo
->screen
))
4164 return intern ("always");
4167 return intern ("when-mapped");
4170 return intern ("not-useful");
4173 error ("Strange value for BackingStore parameter of screen");
4177 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4178 Sx_display_visual_class
, 0, 1, 0,
4179 "Returns the visual class of the X display DISPLAY.\n\
4180 The value is one of the symbols `static-gray', `gray-scale',\n\
4181 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4182 The optional argument DISPLAY specifies which display to ask about.\n\
4183 DISPLAY should be either a frame or a display name (a string).\n\
4184 If omitted or nil, that stands for the selected frame's display.")
4186 Lisp_Object display
;
4188 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4190 switch (dpyinfo
->visual
->class)
4192 case StaticGray
: return (intern ("static-gray"));
4193 case GrayScale
: return (intern ("gray-scale"));
4194 case StaticColor
: return (intern ("static-color"));
4195 case PseudoColor
: return (intern ("pseudo-color"));
4196 case TrueColor
: return (intern ("true-color"));
4197 case DirectColor
: return (intern ("direct-color"));
4199 error ("Display has an unknown visual class");
4203 DEFUN ("x-display-save-under", Fx_display_save_under
,
4204 Sx_display_save_under
, 0, 1, 0,
4205 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4206 The optional argument DISPLAY specifies which display to ask about.\n\
4207 DISPLAY should be either a frame or a display name (a string).\n\
4208 If omitted or nil, that stands for the selected frame's display.")
4210 Lisp_Object display
;
4212 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4214 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4222 register struct frame
*f
;
4224 return PIXEL_WIDTH (f
);
4229 register struct frame
*f
;
4231 return PIXEL_HEIGHT (f
);
4236 register struct frame
*f
;
4238 return FONT_WIDTH (f
->output_data
.x
->font
);
4243 register struct frame
*f
;
4245 return f
->output_data
.x
->line_height
;
4250 register struct frame
*f
;
4252 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4255 #if 0 /* These no longer seem like the right way to do things. */
4257 /* Draw a rectangle on the frame with left top corner including
4258 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4259 CHARS by LINES wide and long and is the color of the cursor. */
4262 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4263 register struct frame
*f
;
4265 register int top_char
, left_char
, chars
, lines
;
4269 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4270 + f
->output_data
.x
->internal_border_width
);
4271 int top
= (top_char
* f
->output_data
.x
->line_height
4272 + f
->output_data
.x
->internal_border_width
);
4275 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4277 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4279 height
= f
->output_data
.x
->line_height
/ 2;
4281 height
= f
->output_data
.x
->line_height
* lines
;
4283 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4284 gc
, left
, top
, width
, height
);
4287 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4288 "Draw a rectangle on FRAME between coordinates specified by\n\
4289 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4290 (frame
, X0
, Y0
, X1
, Y1
)
4291 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4293 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4295 CHECK_LIVE_FRAME (frame
, 0);
4296 CHECK_NUMBER (X0
, 0);
4297 CHECK_NUMBER (Y0
, 1);
4298 CHECK_NUMBER (X1
, 2);
4299 CHECK_NUMBER (Y1
, 3);
4309 n_lines
= y1
- y0
+ 1;
4314 n_lines
= y0
- y1
+ 1;
4320 n_chars
= x1
- x0
+ 1;
4325 n_chars
= x0
- x1
+ 1;
4329 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4330 left
, top
, n_chars
, n_lines
);
4336 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4337 "Draw a rectangle drawn on FRAME between coordinates\n\
4338 X0, Y0, X1, Y1 in the regular background-pixel.")
4339 (frame
, X0
, Y0
, X1
, Y1
)
4340 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4342 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4344 CHECK_LIVE_FRAME (frame
, 0);
4345 CHECK_NUMBER (X0
, 0);
4346 CHECK_NUMBER (Y0
, 1);
4347 CHECK_NUMBER (X1
, 2);
4348 CHECK_NUMBER (Y1
, 3);
4358 n_lines
= y1
- y0
+ 1;
4363 n_lines
= y0
- y1
+ 1;
4369 n_chars
= x1
- x0
+ 1;
4374 n_chars
= x0
- x1
+ 1;
4378 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4379 left
, top
, n_chars
, n_lines
);
4385 /* Draw lines around the text region beginning at the character position
4386 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4387 pixel and line characteristics. */
4389 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4392 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4393 register struct frame
*f
;
4395 int top_x
, top_y
, bottom_x
, bottom_y
;
4397 register int ibw
= f
->output_data
.x
->internal_border_width
;
4398 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4399 register int font_h
= f
->output_data
.x
->line_height
;
4401 int x
= line_len (y
);
4402 XPoint
*pixel_points
4403 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4404 register XPoint
*this_point
= pixel_points
;
4406 /* Do the horizontal top line/lines */
4409 this_point
->x
= ibw
;
4410 this_point
->y
= ibw
+ (font_h
* top_y
);
4413 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4415 this_point
->x
= ibw
+ (font_w
* x
);
4416 this_point
->y
= (this_point
- 1)->y
;
4420 this_point
->x
= ibw
;
4421 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4423 this_point
->x
= ibw
+ (font_w
* top_x
);
4424 this_point
->y
= (this_point
- 1)->y
;
4426 this_point
->x
= (this_point
- 1)->x
;
4427 this_point
->y
= ibw
+ (font_h
* top_y
);
4429 this_point
->x
= ibw
+ (font_w
* x
);
4430 this_point
->y
= (this_point
- 1)->y
;
4433 /* Now do the right side. */
4434 while (y
< bottom_y
)
4435 { /* Right vertical edge */
4437 this_point
->x
= (this_point
- 1)->x
;
4438 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4441 y
++; /* Horizontal connection to next line */
4444 this_point
->x
= ibw
+ (font_w
/ 2);
4446 this_point
->x
= ibw
+ (font_w
* x
);
4448 this_point
->y
= (this_point
- 1)->y
;
4451 /* Now do the bottom and connect to the top left point. */
4452 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4455 this_point
->x
= (this_point
- 1)->x
;
4456 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4458 this_point
->x
= ibw
;
4459 this_point
->y
= (this_point
- 1)->y
;
4461 this_point
->x
= pixel_points
->x
;
4462 this_point
->y
= pixel_points
->y
;
4464 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4466 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4469 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4470 "Highlight the region between point and the character under the mouse\n\
4473 register Lisp_Object event
;
4475 register int x0
, y0
, x1
, y1
;
4476 register struct frame
*f
= selected_frame
;
4477 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4478 register int p1
, p2
;
4480 CHECK_CONS (event
, 0);
4483 x0
= XINT (Fcar (Fcar (event
)));
4484 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4486 /* If the mouse is past the end of the line, don't that area. */
4487 /* ReWrite this... */
4489 /* Where the cursor is. */
4490 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4491 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4493 if (y1
> y0
) /* point below mouse */
4494 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4496 else if (y1
< y0
) /* point above mouse */
4497 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4499 else /* same line: draw horizontal rectangle */
4502 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4503 x0
, y0
, (x1
- x0
+ 1), 1);
4505 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4506 x1
, y1
, (x0
- x1
+ 1), 1);
4509 XFlush (FRAME_X_DISPLAY (f
));
4515 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4516 "Erase any highlighting of the region between point and the character\n\
4517 at X, Y on the selected frame.")
4519 register Lisp_Object event
;
4521 register int x0
, y0
, x1
, y1
;
4522 register struct frame
*f
= selected_frame
;
4523 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4526 x0
= XINT (Fcar (Fcar (event
)));
4527 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4528 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4529 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4531 if (y1
> y0
) /* point below mouse */
4532 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4534 else if (y1
< y0
) /* point above mouse */
4535 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4537 else /* same line: draw horizontal rectangle */
4540 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4541 x0
, y0
, (x1
- x0
+ 1), 1);
4543 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4544 x1
, y1
, (x0
- x1
+ 1), 1);
4552 int contour_begin_x
, contour_begin_y
;
4553 int contour_end_x
, contour_end_y
;
4554 int contour_npoints
;
4556 /* Clip the top part of the contour lines down (and including) line Y_POS.
4557 If X_POS is in the middle (rather than at the end) of the line, drop
4558 down a line at that character. */
4561 clip_contour_top (y_pos
, x_pos
)
4563 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4564 register XPoint
*end
;
4565 register int npoints
;
4566 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4568 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4570 end
= contour_lines
[y_pos
].top_right
;
4571 npoints
= (end
- begin
+ 1);
4572 XDrawLines (x_current_display
, contour_window
,
4573 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4575 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4576 contour_last_point
-= (npoints
- 2);
4577 XDrawLines (x_current_display
, contour_window
,
4578 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4579 XFlush (x_current_display
);
4581 /* Now, update contour_lines structure. */
4586 register XPoint
*p
= begin
+ 1;
4587 end
= contour_lines
[y_pos
].bottom_right
;
4588 npoints
= (end
- begin
+ 1);
4589 XDrawLines (x_current_display
, contour_window
,
4590 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4593 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4595 p
->y
= begin
->y
+ font_h
;
4597 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4598 contour_last_point
-= (npoints
- 5);
4599 XDrawLines (x_current_display
, contour_window
,
4600 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4601 XFlush (x_current_display
);
4603 /* Now, update contour_lines structure. */
4607 /* Erase the top horizontal lines of the contour, and then extend
4608 the contour upwards. */
4611 extend_contour_top (line
)
4616 clip_contour_bottom (x_pos
, y_pos
)
4622 extend_contour_bottom (x_pos
, y_pos
)
4626 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4631 register struct frame
*f
= selected_frame
;
4632 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4633 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4634 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4635 register int mouse_below_point
;
4636 register Lisp_Object obj
;
4637 register int x_contour_x
, x_contour_y
;
4639 x_contour_x
= x_mouse_x
;
4640 x_contour_y
= x_mouse_y
;
4641 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4642 && x_contour_x
> point_x
))
4644 mouse_below_point
= 1;
4645 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4646 x_contour_x
, x_contour_y
);
4650 mouse_below_point
= 0;
4651 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4657 obj
= read_char (-1, 0, 0, Qnil
, 0);
4661 if (mouse_below_point
)
4663 if (x_mouse_y
<= point_y
) /* Flipped. */
4665 mouse_below_point
= 0;
4667 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4668 x_contour_x
, x_contour_y
);
4669 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4672 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4674 clip_contour_bottom (x_mouse_y
);
4676 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4678 extend_bottom_contour (x_mouse_y
);
4681 x_contour_x
= x_mouse_x
;
4682 x_contour_y
= x_mouse_y
;
4684 else /* mouse above or same line as point */
4686 if (x_mouse_y
>= point_y
) /* Flipped. */
4688 mouse_below_point
= 1;
4690 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4691 x_contour_x
, x_contour_y
, point_x
, point_y
);
4692 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4693 x_mouse_x
, x_mouse_y
);
4695 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4697 clip_contour_top (x_mouse_y
);
4699 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4701 extend_contour_top (x_mouse_y
);
4706 unread_command_event
= obj
;
4707 if (mouse_below_point
)
4709 contour_begin_x
= point_x
;
4710 contour_begin_y
= point_y
;
4711 contour_end_x
= x_contour_x
;
4712 contour_end_y
= x_contour_y
;
4716 contour_begin_x
= x_contour_x
;
4717 contour_begin_y
= x_contour_y
;
4718 contour_end_x
= point_x
;
4719 contour_end_y
= point_y
;
4724 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4729 register Lisp_Object obj
;
4730 struct frame
*f
= selected_frame
;
4731 register struct window
*w
= XWINDOW (selected_window
);
4732 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4733 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4735 char dash_list
[] = {6, 4, 6, 4};
4737 XGCValues gc_values
;
4739 register int previous_y
;
4740 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4741 + f
->output_data
.x
->internal_border_width
;
4742 register int left
= f
->output_data
.x
->internal_border_width
4743 + (WINDOW_LEFT_MARGIN (w
)
4744 * FONT_WIDTH (f
->output_data
.x
->font
));
4745 register int right
= left
+ (w
->width
4746 * FONT_WIDTH (f
->output_data
.x
->font
))
4747 - f
->output_data
.x
->internal_border_width
;
4751 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4752 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4753 gc_values
.line_width
= 1;
4754 gc_values
.line_style
= LineOnOffDash
;
4755 gc_values
.cap_style
= CapRound
;
4756 gc_values
.join_style
= JoinRound
;
4758 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4759 GCLineStyle
| GCJoinStyle
| GCCapStyle
4760 | GCLineWidth
| GCForeground
| GCBackground
,
4762 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4763 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4764 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4765 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4766 GCLineStyle
| GCJoinStyle
| GCCapStyle
4767 | GCLineWidth
| GCForeground
| GCBackground
,
4769 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4776 if (x_mouse_y
>= XINT (w
->top
)
4777 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4779 previous_y
= x_mouse_y
;
4780 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4781 + f
->output_data
.x
->internal_border_width
;
4782 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4783 line_gc
, left
, line
, right
, line
);
4785 XFlush (FRAME_X_DISPLAY (f
));
4790 obj
= read_char (-1, 0, 0, Qnil
, 0);
4792 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4793 Qvertical_scroll_bar
))
4797 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4798 erase_gc
, left
, line
, right
, line
);
4799 unread_command_event
= obj
;
4801 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4802 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4808 while (x_mouse_y
== previous_y
);
4811 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4812 erase_gc
, left
, line
, right
, line
);
4819 /* These keep track of the rectangle following the pointer. */
4820 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4822 /* Offset in buffer of character under the pointer, or 0. */
4823 int mouse_buffer_offset
;
4825 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4826 "Track the pointer.")
4829 static Cursor current_pointer_shape
;
4830 FRAME_PTR f
= x_mouse_frame
;
4833 if (EQ (Vmouse_frame_part
, Qtext_part
)
4834 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4839 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4840 XDefineCursor (FRAME_X_DISPLAY (f
),
4842 current_pointer_shape
);
4844 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4845 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4847 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4848 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4850 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4851 XDefineCursor (FRAME_X_DISPLAY (f
),
4853 current_pointer_shape
);
4856 XFlush (FRAME_X_DISPLAY (f
));
4862 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4863 "Draw rectangle around character under mouse pointer, if there is one.")
4867 struct window
*w
= XWINDOW (Vmouse_window
);
4868 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4869 struct buffer
*b
= XBUFFER (w
->buffer
);
4872 if (! EQ (Vmouse_window
, selected_window
))
4875 if (EQ (event
, Qnil
))
4879 x_read_mouse_position (selected_frame
, &x
, &y
);
4883 mouse_track_width
= 0;
4884 mouse_track_left
= mouse_track_top
= -1;
4888 if ((x_mouse_x
!= mouse_track_left
4889 && (x_mouse_x
< mouse_track_left
4890 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4891 || x_mouse_y
!= mouse_track_top
)
4893 int hp
= 0; /* Horizontal position */
4894 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4895 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4896 int tab_width
= XINT (b
->tab_width
);
4897 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4899 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4900 int in_mode_line
= 0;
4902 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4905 /* Erase previous rectangle. */
4906 if (mouse_track_width
)
4908 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4909 mouse_track_left
, mouse_track_top
,
4910 mouse_track_width
, 1);
4912 if ((mouse_track_left
== f
->phys_cursor_x
4913 || mouse_track_left
== f
->phys_cursor_x
- 1)
4914 && mouse_track_top
== f
->phys_cursor_y
)
4916 x_display_cursor (f
, 1);
4920 mouse_track_left
= x_mouse_x
;
4921 mouse_track_top
= x_mouse_y
;
4922 mouse_track_width
= 0;
4924 if (mouse_track_left
> len
) /* Past the end of line. */
4927 if (mouse_track_top
== mode_line_vpos
)
4933 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4937 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4943 mouse_track_width
= tab_width
- (hp
% tab_width
);
4945 hp
+= mouse_track_width
;
4948 mouse_track_left
= hp
- mouse_track_width
;
4954 mouse_track_width
= -1;
4958 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4963 mouse_track_width
= 2;
4968 mouse_track_left
= hp
- mouse_track_width
;
4974 mouse_track_width
= 1;
4981 while (hp
<= x_mouse_x
);
4984 if (mouse_track_width
) /* Over text; use text pointer shape. */
4986 XDefineCursor (FRAME_X_DISPLAY (f
),
4988 f
->output_data
.x
->text_cursor
);
4989 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4990 mouse_track_left
, mouse_track_top
,
4991 mouse_track_width
, 1);
4993 else if (in_mode_line
)
4994 XDefineCursor (FRAME_X_DISPLAY (f
),
4996 f
->output_data
.x
->modeline_cursor
);
4998 XDefineCursor (FRAME_X_DISPLAY (f
),
5000 f
->output_data
.x
->nontext_cursor
);
5003 XFlush (FRAME_X_DISPLAY (f
));
5006 obj
= read_char (-1, 0, 0, Qnil
, 0);
5009 while (CONSP (obj
) /* Mouse event */
5010 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5011 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5012 && EQ (Vmouse_window
, selected_window
) /* In this window */
5015 unread_command_event
= obj
;
5017 if (mouse_track_width
)
5019 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5020 mouse_track_left
, mouse_track_top
,
5021 mouse_track_width
, 1);
5022 mouse_track_width
= 0;
5023 if ((mouse_track_left
== f
->phys_cursor_x
5024 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5025 && mouse_track_top
== f
->phys_cursor_y
)
5027 x_display_cursor (f
, 1);
5030 XDefineCursor (FRAME_X_DISPLAY (f
),
5032 f
->output_data
.x
->nontext_cursor
);
5033 XFlush (FRAME_X_DISPLAY (f
));
5043 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5044 on the frame F at position X, Y. */
5046 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5048 int x
, y
, width
, height
;
5053 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5054 FRAME_X_WINDOW (f
), image_data
,
5056 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5057 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5061 #if 0 /* I'm told these functions are superfluous
5062 given the ability to bind function keys. */
5065 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5066 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5067 KEYSYM is a string which conforms to the X keysym definitions found\n\
5068 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5069 list of strings specifying modifier keys such as Control_L, which must\n\
5070 also be depressed for NEWSTRING to appear.")
5071 (x_keysym
, modifiers
, newstring
)
5072 register Lisp_Object x_keysym
;
5073 register Lisp_Object modifiers
;
5074 register Lisp_Object newstring
;
5077 register KeySym keysym
;
5078 KeySym modifier_list
[16];
5081 CHECK_STRING (x_keysym
, 1);
5082 CHECK_STRING (newstring
, 3);
5084 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5085 if (keysym
== NoSymbol
)
5086 error ("Keysym does not exist");
5088 if (NILP (modifiers
))
5089 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5090 XSTRING (newstring
)->data
,
5091 STRING_BYTES (XSTRING (newstring
)));
5094 register Lisp_Object rest
, mod
;
5097 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5100 error ("Can't have more than 16 modifiers");
5103 CHECK_STRING (mod
, 3);
5104 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5106 if (modifier_list
[i
] == NoSymbol
5107 || !(IsModifierKey (modifier_list
[i
])
5108 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5109 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5111 if (modifier_list
[i
] == NoSymbol
5112 || !IsModifierKey (modifier_list
[i
]))
5114 error ("Element is not a modifier keysym");
5118 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5119 XSTRING (newstring
)->data
,
5120 STRING_BYTES (XSTRING (newstring
)));
5126 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5127 "Rebind KEYCODE to list of strings STRINGS.\n\
5128 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5129 nil as element means don't change.\n\
5130 See the documentation of `x-rebind-key' for more information.")
5132 register Lisp_Object keycode
;
5133 register Lisp_Object strings
;
5135 register Lisp_Object item
;
5136 register unsigned char *rawstring
;
5137 KeySym rawkey
, modifier
[1];
5139 register unsigned i
;
5142 CHECK_NUMBER (keycode
, 1);
5143 CHECK_CONS (strings
, 2);
5144 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5145 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5147 item
= Fcar (strings
);
5150 CHECK_STRING (item
, 2);
5151 strsize
= STRING_BYTES (XSTRING (item
));
5152 rawstring
= (unsigned char *) xmalloc (strsize
);
5153 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5154 modifier
[1] = 1 << i
;
5155 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5156 rawstring
, strsize
);
5161 #endif /* HAVE_X11 */
5164 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5166 XScreenNumberOfScreen (scr
)
5167 register Screen
*scr
;
5169 register Display
*dpy
;
5170 register Screen
*dpyscr
;
5174 dpyscr
= dpy
->screens
;
5176 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5182 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5185 select_visual (dpy
, screen
, depth
)
5188 unsigned int *depth
;
5191 XVisualInfo
*vinfo
, vinfo_template
;
5194 v
= DefaultVisualOfScreen (screen
);
5197 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5199 vinfo_template
.visualid
= v
->visualid
;
5202 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5204 vinfo
= XGetVisualInfo (dpy
,
5205 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5208 fatal ("Can't get proper X visual info");
5210 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5211 *depth
= vinfo
->depth
;
5215 int n
= vinfo
->colormap_size
- 1;
5224 XFree ((char *) vinfo
);
5228 /* Return the X display structure for the display named NAME.
5229 Open a new connection if necessary. */
5231 struct x_display_info
*
5232 x_display_info_for_name (name
)
5236 struct x_display_info
*dpyinfo
;
5238 CHECK_STRING (name
, 0);
5240 if (! EQ (Vwindow_system
, intern ("x")))
5241 error ("Not using X Windows");
5243 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5245 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5248 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5253 /* Use this general default value to start with. */
5254 Vx_resource_name
= Vinvocation_name
;
5256 validate_x_resource_name ();
5258 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5259 (char *) XSTRING (Vx_resource_name
)->data
);
5262 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5265 XSETFASTINT (Vwindow_system_version
, 11);
5270 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5271 1, 3, 0, "Open a connection to an X server.\n\
5272 DISPLAY is the name of the display to connect to.\n\
5273 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5274 If the optional third arg MUST-SUCCEED is non-nil,\n\
5275 terminate Emacs if we can't open the connection.")
5276 (display
, xrm_string
, must_succeed
)
5277 Lisp_Object display
, xrm_string
, must_succeed
;
5279 unsigned char *xrm_option
;
5280 struct x_display_info
*dpyinfo
;
5282 CHECK_STRING (display
, 0);
5283 if (! NILP (xrm_string
))
5284 CHECK_STRING (xrm_string
, 1);
5286 if (! EQ (Vwindow_system
, intern ("x")))
5287 error ("Not using X Windows");
5289 if (! NILP (xrm_string
))
5290 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5292 xrm_option
= (unsigned char *) 0;
5294 validate_x_resource_name ();
5296 /* This is what opens the connection and sets x_current_display.
5297 This also initializes many symbols, such as those used for input. */
5298 dpyinfo
= x_term_init (display
, xrm_option
,
5299 (char *) XSTRING (Vx_resource_name
)->data
);
5303 if (!NILP (must_succeed
))
5304 fatal ("Cannot connect to X server %s.\n\
5305 Check the DISPLAY environment variable or use `-d'.\n\
5306 Also use the `xhost' program to verify that it is set to permit\n\
5307 connections from your machine.\n",
5308 XSTRING (display
)->data
);
5310 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5315 XSETFASTINT (Vwindow_system_version
, 11);
5319 DEFUN ("x-close-connection", Fx_close_connection
,
5320 Sx_close_connection
, 1, 1, 0,
5321 "Close the connection to DISPLAY's X server.\n\
5322 For DISPLAY, specify either a frame or a display name (a string).\n\
5323 If DISPLAY is nil, that stands for the selected frame's display.")
5325 Lisp_Object display
;
5327 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5330 if (dpyinfo
->reference_count
> 0)
5331 error ("Display still has frames on it");
5334 /* Free the fonts in the font table. */
5335 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5336 if (dpyinfo
->font_table
[i
].name
)
5338 xfree (dpyinfo
->font_table
[i
].name
);
5339 /* Don't free the full_name string;
5340 it is always shared with something else. */
5341 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5344 x_destroy_all_bitmaps (dpyinfo
);
5345 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5347 #ifdef USE_X_TOOLKIT
5348 XtCloseDisplay (dpyinfo
->display
);
5350 XCloseDisplay (dpyinfo
->display
);
5353 x_delete_display (dpyinfo
);
5359 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5360 "Return the list of display names that Emacs has connections to.")
5363 Lisp_Object tail
, result
;
5366 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5367 result
= Fcons (XCAR (XCAR (tail
)), result
);
5372 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5373 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5374 If ON is nil, allow buffering of requests.\n\
5375 Turning on synchronization prohibits the Xlib routines from buffering\n\
5376 requests and seriously degrades performance, but makes debugging much\n\
5378 The optional second argument DISPLAY specifies which display to act on.\n\
5379 DISPLAY should be either a frame or a display name (a string).\n\
5380 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5382 Lisp_Object display
, on
;
5384 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5386 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5391 /* Wait for responses to all X commands issued so far for frame F. */
5398 XSync (FRAME_X_DISPLAY (f
), False
);
5403 /***********************************************************************
5405 ***********************************************************************/
5407 /* Value is the number of elements of vector VECTOR. */
5409 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5411 /* List of supported image types. Use define_image_type to add new
5412 types. Use lookup_image_type to find a type for a given symbol. */
5414 static struct image_type
*image_types
;
5416 /* A list of symbols, one for each supported image type. */
5418 Lisp_Object Vimage_types
;
5420 /* The symbol `image' which is the car of the lists used to represent
5423 extern Lisp_Object Qimage
;
5425 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5431 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5432 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5433 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5434 Lisp_Object QCindex
;
5436 /* Other symbols. */
5438 Lisp_Object Qlaplace
;
5440 /* Time in seconds after which images should be removed from the cache
5441 if not displayed. */
5443 Lisp_Object Vimage_cache_eviction_delay
;
5445 /* Function prototypes. */
5447 static void define_image_type
P_ ((struct image_type
*type
));
5448 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5449 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5450 static void x_laplace
P_ ((struct frame
*, struct image
*));
5451 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5455 /* Define a new image type from TYPE. This adds a copy of TYPE to
5456 image_types and adds the symbol *TYPE->type to Vimage_types. */
5459 define_image_type (type
)
5460 struct image_type
*type
;
5462 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5463 The initialized data segment is read-only. */
5464 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5465 bcopy (type
, p
, sizeof *p
);
5466 p
->next
= image_types
;
5468 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5472 /* Look up image type SYMBOL, and return a pointer to its image_type
5473 structure. Value is null if SYMBOL is not a known image type. */
5475 static INLINE
struct image_type
*
5476 lookup_image_type (symbol
)
5479 struct image_type
*type
;
5481 for (type
= image_types
; type
; type
= type
->next
)
5482 if (EQ (symbol
, *type
->type
))
5489 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5490 valid image specification is a list whose car is the symbol
5491 `image', and whose rest is a property list. The property list must
5492 contain a value for key `:type'. That value must be the name of a
5493 supported image type. The rest of the property list depends on the
5497 valid_image_p (object
)
5502 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5504 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5505 struct image_type
*type
= lookup_image_type (symbol
);
5508 valid_p
= type
->valid_p (object
);
5515 /* Log error message with format string FORMAT and argument ARG.
5516 Signaling an error, e.g. when an image cannot be loaded, is not a
5517 good idea because this would interrupt redisplay, and the error
5518 message display would lead to another redisplay. This function
5519 therefore simply displays a message. */
5522 image_error (format
, arg1
, arg2
)
5524 Lisp_Object arg1
, arg2
;
5526 add_to_log (format
, arg1
, arg2
);
5531 /***********************************************************************
5532 Image specifications
5533 ***********************************************************************/
5535 enum image_value_type
5537 IMAGE_DONT_CHECK_VALUE_TYPE
,
5540 IMAGE_POSITIVE_INTEGER_VALUE
,
5541 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5542 IMAGE_INTEGER_VALUE
,
5543 IMAGE_FUNCTION_VALUE
,
5548 /* Structure used when parsing image specifications. */
5550 struct image_keyword
5552 /* Name of keyword. */
5555 /* The type of value allowed. */
5556 enum image_value_type type
;
5558 /* Non-zero means key must be present. */
5561 /* Used to recognize duplicate keywords in a property list. */
5564 /* The value that was found. */
5569 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5571 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5574 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5575 has the format (image KEYWORD VALUE ...). One of the keyword/
5576 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5577 image_keywords structures of size NKEYWORDS describing other
5578 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5581 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5583 struct image_keyword
*keywords
;
5590 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5593 plist
= XCDR (spec
);
5594 while (CONSP (plist
))
5596 Lisp_Object key
, value
;
5598 /* First element of a pair must be a symbol. */
5600 plist
= XCDR (plist
);
5604 /* There must follow a value. */
5607 value
= XCAR (plist
);
5608 plist
= XCDR (plist
);
5610 /* Find key in KEYWORDS. Error if not found. */
5611 for (i
= 0; i
< nkeywords
; ++i
)
5612 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5618 /* Record that we recognized the keyword. If a keywords
5619 was found more than once, it's an error. */
5620 keywords
[i
].value
= value
;
5621 ++keywords
[i
].count
;
5623 if (keywords
[i
].count
> 1)
5626 /* Check type of value against allowed type. */
5627 switch (keywords
[i
].type
)
5629 case IMAGE_STRING_VALUE
:
5630 if (!STRINGP (value
))
5634 case IMAGE_SYMBOL_VALUE
:
5635 if (!SYMBOLP (value
))
5639 case IMAGE_POSITIVE_INTEGER_VALUE
:
5640 if (!INTEGERP (value
) || XINT (value
) <= 0)
5644 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5645 if (!INTEGERP (value
) || XINT (value
) < 0)
5649 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5652 case IMAGE_FUNCTION_VALUE
:
5653 value
= indirect_function (value
);
5655 || COMPILEDP (value
)
5656 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5660 case IMAGE_NUMBER_VALUE
:
5661 if (!INTEGERP (value
) && !FLOATP (value
))
5665 case IMAGE_INTEGER_VALUE
:
5666 if (!INTEGERP (value
))
5670 case IMAGE_BOOL_VALUE
:
5671 if (!NILP (value
) && !EQ (value
, Qt
))
5680 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5684 /* Check that all mandatory fields are present. */
5685 for (i
= 0; i
< nkeywords
; ++i
)
5686 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5689 return NILP (plist
);
5693 /* Return the value of KEY in image specification SPEC. Value is nil
5694 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5695 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5698 image_spec_value (spec
, key
, found
)
5699 Lisp_Object spec
, key
;
5704 xassert (valid_image_p (spec
));
5706 for (tail
= XCDR (spec
);
5707 CONSP (tail
) && CONSP (XCDR (tail
));
5708 tail
= XCDR (XCDR (tail
)))
5710 if (EQ (XCAR (tail
), key
))
5714 return XCAR (XCDR (tail
));
5726 /***********************************************************************
5727 Image type independent image structures
5728 ***********************************************************************/
5730 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5731 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5734 /* Allocate and return a new image structure for image specification
5735 SPEC. SPEC has a hash value of HASH. */
5737 static struct image
*
5738 make_image (spec
, hash
)
5742 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5744 xassert (valid_image_p (spec
));
5745 bzero (img
, sizeof *img
);
5746 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5747 xassert (img
->type
!= NULL
);
5749 img
->data
.lisp_val
= Qnil
;
5750 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5756 /* Free image IMG which was used on frame F, including its resources. */
5765 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5767 /* Remove IMG from the hash table of its cache. */
5769 img
->prev
->next
= img
->next
;
5771 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5774 img
->next
->prev
= img
->prev
;
5776 c
->images
[img
->id
] = NULL
;
5778 /* Free resources, then free IMG. */
5779 img
->type
->free (f
, img
);
5785 /* Prepare image IMG for display on frame F. Must be called before
5786 drawing an image. */
5789 prepare_image_for_display (f
, img
)
5795 /* We're about to display IMG, so set its timestamp to `now'. */
5797 img
->timestamp
= EMACS_SECS (t
);
5799 /* If IMG doesn't have a pixmap yet, load it now, using the image
5800 type dependent loader function. */
5801 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5802 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5807 /***********************************************************************
5808 Helper functions for X image types
5809 ***********************************************************************/
5811 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5812 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5814 Lisp_Object color_name
,
5815 unsigned long dflt
));
5817 /* Free X resources of image IMG which is used on frame F. */
5820 x_clear_image (f
, img
)
5827 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5834 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5836 /* If display has an immutable color map, freeing colors is not
5837 necessary and some servers don't allow it. So don't do it. */
5838 if (class != StaticColor
5839 && class != StaticGray
5840 && class != TrueColor
)
5844 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5845 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5850 xfree (img
->colors
);
5857 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5858 cannot be allocated, use DFLT. Add a newly allocated color to
5859 IMG->colors, so that it can be freed again. Value is the pixel
5862 static unsigned long
5863 x_alloc_image_color (f
, img
, color_name
, dflt
)
5866 Lisp_Object color_name
;
5870 unsigned long result
;
5872 xassert (STRINGP (color_name
));
5874 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5876 /* This isn't called frequently so we get away with simply
5877 reallocating the color vector to the needed size, here. */
5880 (unsigned long *) xrealloc (img
->colors
,
5881 img
->ncolors
* sizeof *img
->colors
);
5882 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5883 result
= color
.pixel
;
5893 /***********************************************************************
5895 ***********************************************************************/
5897 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5900 /* Return a new, initialized image cache that is allocated from the
5901 heap. Call free_image_cache to free an image cache. */
5903 struct image_cache
*
5906 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5909 bzero (c
, sizeof *c
);
5911 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5912 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5913 c
->buckets
= (struct image
**) xmalloc (size
);
5914 bzero (c
->buckets
, size
);
5919 /* Free image cache of frame F. Be aware that X frames share images
5923 free_image_cache (f
)
5926 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5931 /* Cache should not be referenced by any frame when freed. */
5932 xassert (c
->refcount
== 0);
5934 for (i
= 0; i
< c
->used
; ++i
)
5935 free_image (f
, c
->images
[i
]);
5939 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5944 /* Clear image cache of frame F. FORCE_P non-zero means free all
5945 images. FORCE_P zero means clear only images that haven't been
5946 displayed for some time. Should be called from time to time to
5947 reduce the number of loaded images. If image-eviction-seconds is
5948 non-nil, this frees images in the cache which weren't displayed for
5949 at least that many seconds. */
5952 clear_image_cache (f
, force_p
)
5956 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5958 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5962 int i
, any_freed_p
= 0;
5965 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5967 for (i
= 0; i
< c
->used
; ++i
)
5969 struct image
*img
= c
->images
[i
];
5972 || (img
->timestamp
> old
)))
5974 free_image (f
, img
);
5979 /* We may be clearing the image cache because, for example,
5980 Emacs was iconified for a longer period of time. In that
5981 case, current matrices may still contain references to
5982 images freed above. So, clear these matrices. */
5985 clear_current_matrices (f
);
5986 ++windows_or_buffers_changed
;
5992 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5994 "Clear the image cache of FRAME.\n\
5995 FRAME nil or omitted means use the selected frame.\n\
5996 FRAME t means clear the image caches of all frames.")
6004 FOR_EACH_FRAME (tail
, frame
)
6005 if (FRAME_X_P (XFRAME (frame
)))
6006 clear_image_cache (XFRAME (frame
), 1);
6009 clear_image_cache (check_x_frame (frame
), 1);
6015 /* Return the id of image with Lisp specification SPEC on frame F.
6016 SPEC must be a valid Lisp image specification (see valid_image_p). */
6019 lookup_image (f
, spec
)
6023 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6027 struct gcpro gcpro1
;
6030 /* F must be a window-system frame, and SPEC must be a valid image
6032 xassert (FRAME_WINDOW_P (f
));
6033 xassert (valid_image_p (spec
));
6037 /* Look up SPEC in the hash table of the image cache. */
6038 hash
= sxhash (spec
, 0);
6039 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6041 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6042 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6045 /* If not found, create a new image and cache it. */
6048 img
= make_image (spec
, hash
);
6049 cache_image (f
, img
);
6050 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6051 xassert (!interrupt_input_blocked
);
6053 /* If we can't load the image, and we don't have a width and
6054 height, use some arbitrary width and height so that we can
6055 draw a rectangle for it. */
6056 if (img
->load_failed_p
)
6060 value
= image_spec_value (spec
, QCwidth
, NULL
);
6061 img
->width
= (INTEGERP (value
)
6062 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6063 value
= image_spec_value (spec
, QCheight
, NULL
);
6064 img
->height
= (INTEGERP (value
)
6065 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6069 /* Handle image type independent image attributes
6070 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6071 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6074 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6075 if (INTEGERP (ascent
))
6076 img
->ascent
= XFASTINT (ascent
);
6078 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6079 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6080 img
->margin
= XFASTINT (margin
);
6082 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6083 if (INTEGERP (relief
))
6085 img
->relief
= XINT (relief
);
6086 img
->margin
+= abs (img
->relief
);
6089 /* Should we apply a Laplace edge-detection algorithm? */
6090 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6091 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6094 /* Should we built a mask heuristically? */
6095 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6096 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6097 x_build_heuristic_mask (f
, img
, heuristic_mask
);
6101 /* We're using IMG, so set its timestamp to `now'. */
6102 EMACS_GET_TIME (now
);
6103 img
->timestamp
= EMACS_SECS (now
);
6107 /* Value is the image id. */
6112 /* Cache image IMG in the image cache of frame F. */
6115 cache_image (f
, img
)
6119 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6122 /* Find a free slot in c->images. */
6123 for (i
= 0; i
< c
->used
; ++i
)
6124 if (c
->images
[i
] == NULL
)
6127 /* If no free slot found, maybe enlarge c->images. */
6128 if (i
== c
->used
&& c
->used
== c
->size
)
6131 c
->images
= (struct image
**) xrealloc (c
->images
,
6132 c
->size
* sizeof *c
->images
);
6135 /* Add IMG to c->images, and assign IMG an id. */
6141 /* Add IMG to the cache's hash table. */
6142 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6143 img
->next
= c
->buckets
[i
];
6145 img
->next
->prev
= img
;
6147 c
->buckets
[i
] = img
;
6151 /* Call FN on every image in the image cache of frame F. Used to mark
6152 Lisp Objects in the image cache. */
6155 forall_images_in_image_cache (f
, fn
)
6157 void (*fn
) P_ ((struct image
*img
));
6159 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6161 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6165 for (i
= 0; i
< c
->used
; ++i
)
6174 /***********************************************************************
6176 ***********************************************************************/
6178 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6179 XImage
**, Pixmap
*));
6180 static void x_destroy_x_image
P_ ((XImage
*));
6181 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6184 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6185 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6186 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6187 via xmalloc. Print error messages via image_error if an error
6188 occurs. Value is non-zero if successful. */
6191 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6193 int width
, height
, depth
;
6197 Display
*display
= FRAME_X_DISPLAY (f
);
6198 Screen
*screen
= FRAME_X_SCREEN (f
);
6199 Window window
= FRAME_X_WINDOW (f
);
6201 xassert (interrupt_input_blocked
);
6204 depth
= DefaultDepthOfScreen (screen
);
6205 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6206 depth
, ZPixmap
, 0, NULL
, width
, height
,
6207 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6210 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6214 /* Allocate image raster. */
6215 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6217 /* Allocate a pixmap of the same size. */
6218 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6221 x_destroy_x_image (*ximg
);
6223 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6231 /* Destroy XImage XIMG. Free XIMG->data. */
6234 x_destroy_x_image (ximg
)
6237 xassert (interrupt_input_blocked
);
6242 XDestroyImage (ximg
);
6247 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6248 are width and height of both the image and pixmap. */
6251 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6258 xassert (interrupt_input_blocked
);
6259 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6260 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6261 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6266 /***********************************************************************
6268 ***********************************************************************/
6270 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6272 /* Find image file FILE. Look in data-directory, then
6273 x-bitmap-file-path. Value is the full name of the file found, or
6274 nil if not found. */
6277 x_find_image_file (file
)
6280 Lisp_Object file_found
, search_path
;
6281 struct gcpro gcpro1
, gcpro2
;
6285 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6286 GCPRO2 (file_found
, search_path
);
6288 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6289 fd
= openp (search_path
, file
, "", &file_found
, 0);
6302 /***********************************************************************
6304 ***********************************************************************/
6306 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6307 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6309 static int xbm_image_p
P_ ((Lisp_Object object
));
6310 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6314 /* Indices of image specification fields in xbm_format, below. */
6316 enum xbm_keyword_index
6333 /* Vector of image_keyword structures describing the format
6334 of valid XBM image specifications. */
6336 static struct image_keyword xbm_format
[XBM_LAST
] =
6338 {":type", IMAGE_SYMBOL_VALUE
, 1},
6339 {":file", IMAGE_STRING_VALUE
, 0},
6340 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6341 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6342 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6343 {":foreground", IMAGE_STRING_VALUE
, 0},
6344 {":background", IMAGE_STRING_VALUE
, 0},
6345 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6346 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6347 {":relief", IMAGE_INTEGER_VALUE
, 0},
6348 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6349 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6352 /* Structure describing the image type XBM. */
6354 static struct image_type xbm_type
=
6363 /* Tokens returned from xbm_scan. */
6372 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6373 A valid specification is a list starting with the symbol `image'
6374 The rest of the list is a property list which must contain an
6377 If the specification specifies a file to load, it must contain
6378 an entry `:file FILENAME' where FILENAME is a string.
6380 If the specification is for a bitmap loaded from memory it must
6381 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6382 WIDTH and HEIGHT are integers > 0. DATA may be:
6384 1. a string large enough to hold the bitmap data, i.e. it must
6385 have a size >= (WIDTH + 7) / 8 * HEIGHT
6387 2. a bool-vector of size >= WIDTH * HEIGHT
6389 3. a vector of strings or bool-vectors, one for each line of the
6392 Both the file and data forms may contain the additional entries
6393 `:background COLOR' and `:foreground COLOR'. If not present,
6394 foreground and background of the frame on which the image is
6395 displayed, is used. */
6398 xbm_image_p (object
)
6401 struct image_keyword kw
[XBM_LAST
];
6403 bcopy (xbm_format
, kw
, sizeof kw
);
6404 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6407 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6409 if (kw
[XBM_FILE
].count
)
6411 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6419 /* Entries for `:width', `:height' and `:data' must be present. */
6420 if (!kw
[XBM_WIDTH
].count
6421 || !kw
[XBM_HEIGHT
].count
6422 || !kw
[XBM_DATA
].count
)
6425 data
= kw
[XBM_DATA
].value
;
6426 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6427 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6429 /* Check type of data, and width and height against contents of
6435 /* Number of elements of the vector must be >= height. */
6436 if (XVECTOR (data
)->size
< height
)
6439 /* Each string or bool-vector in data must be large enough
6440 for one line of the image. */
6441 for (i
= 0; i
< height
; ++i
)
6443 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6447 if (XSTRING (elt
)->size
6448 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6451 else if (BOOL_VECTOR_P (elt
))
6453 if (XBOOL_VECTOR (elt
)->size
< width
)
6460 else if (STRINGP (data
))
6462 if (XSTRING (data
)->size
6463 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6466 else if (BOOL_VECTOR_P (data
))
6468 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6475 /* Baseline must be a value between 0 and 100 (a percentage). */
6476 if (kw
[XBM_ASCENT
].count
6477 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6484 /* Scan a bitmap file. FP is the stream to read from. Value is
6485 either an enumerator from enum xbm_token, or a character for a
6486 single-character token, or 0 at end of file. If scanning an
6487 identifier, store the lexeme of the identifier in SVAL. If
6488 scanning a number, store its value in *IVAL. */
6491 xbm_scan (fp
, sval
, ival
)
6498 /* Skip white space. */
6499 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6504 else if (isdigit (c
))
6506 int value
= 0, digit
;
6511 if (c
== 'x' || c
== 'X')
6513 while ((c
= fgetc (fp
)) != EOF
)
6517 else if (c
>= 'a' && c
<= 'f')
6518 digit
= c
- 'a' + 10;
6519 else if (c
>= 'A' && c
<= 'F')
6520 digit
= c
- 'A' + 10;
6523 value
= 16 * value
+ digit
;
6526 else if (isdigit (c
))
6529 while ((c
= fgetc (fp
)) != EOF
6531 value
= 8 * value
+ c
- '0';
6537 while ((c
= fgetc (fp
)) != EOF
6539 value
= 10 * value
+ c
- '0';
6547 else if (isalpha (c
) || c
== '_')
6550 while ((c
= fgetc (fp
)) != EOF
6551 && (isalnum (c
) || c
== '_'))
6563 /* Replacement for XReadBitmapFileData which isn't available under old
6564 X versions. FILE is the name of the bitmap file to read. Set
6565 *WIDTH and *HEIGHT to the width and height of the image. Return in
6566 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6570 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6572 int *width
, *height
;
6573 unsigned char **data
;
6576 char buffer
[BUFSIZ
];
6579 int bytes_per_line
, i
, nbytes
;
6585 LA1 = xbm_scan (fp, buffer, &value)
6587 #define expect(TOKEN) \
6588 if (LA1 != (TOKEN)) \
6593 #define expect_ident(IDENT) \
6594 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6599 fp
= fopen (file
, "r");
6603 *width
= *height
= -1;
6605 LA1
= xbm_scan (fp
, buffer
, &value
);
6607 /* Parse defines for width, height and hot-spots. */
6611 expect_ident ("define");
6612 expect (XBM_TK_IDENT
);
6614 if (LA1
== XBM_TK_NUMBER
);
6616 char *p
= strrchr (buffer
, '_');
6617 p
= p
? p
+ 1 : buffer
;
6618 if (strcmp (p
, "width") == 0)
6620 else if (strcmp (p
, "height") == 0)
6623 expect (XBM_TK_NUMBER
);
6626 if (*width
< 0 || *height
< 0)
6629 /* Parse bits. Must start with `static'. */
6630 expect_ident ("static");
6631 if (LA1
== XBM_TK_IDENT
)
6633 if (strcmp (buffer
, "unsigned") == 0)
6636 expect_ident ("char");
6638 else if (strcmp (buffer
, "short") == 0)
6642 if (*width
% 16 && *width
% 16 < 9)
6645 else if (strcmp (buffer
, "char") == 0)
6653 expect (XBM_TK_IDENT
);
6659 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6660 nbytes
= bytes_per_line
* *height
;
6661 p
= *data
= (char *) xmalloc (nbytes
);
6666 for (i
= 0; i
< nbytes
; i
+= 2)
6669 expect (XBM_TK_NUMBER
);
6672 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6675 if (LA1
== ',' || LA1
== '}')
6683 for (i
= 0; i
< nbytes
; ++i
)
6686 expect (XBM_TK_NUMBER
);
6690 if (LA1
== ',' || LA1
== '}')
6716 /* Load XBM image IMG which will be displayed on frame F from file
6717 SPECIFIED_FILE. Value is non-zero if successful. */
6720 xbm_load_image_from_file (f
, img
, specified_file
)
6723 Lisp_Object specified_file
;
6726 unsigned char *data
;
6729 struct gcpro gcpro1
;
6731 xassert (STRINGP (specified_file
));
6735 file
= x_find_image_file (specified_file
);
6736 if (!STRINGP (file
))
6738 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6743 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6744 &img
->height
, &data
);
6747 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6748 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6749 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6752 xassert (img
->width
> 0 && img
->height
> 0);
6754 /* Get foreground and background colors, maybe allocate colors. */
6755 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6757 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6759 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6761 background
= x_alloc_image_color (f
, img
, value
, background
);
6765 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6768 img
->width
, img
->height
,
6769 foreground
, background
,
6773 if (img
->pixmap
== 0)
6775 x_clear_image (f
, img
);
6776 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6784 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6791 /* Fill image IMG which is used on frame F with pixmap data. Value is
6792 non-zero if successful. */
6800 Lisp_Object file_name
;
6802 xassert (xbm_image_p (img
->spec
));
6804 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6805 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6806 if (STRINGP (file_name
))
6807 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6810 struct image_keyword fmt
[XBM_LAST
];
6813 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6814 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6818 /* Parse the list specification. */
6819 bcopy (xbm_format
, fmt
, sizeof fmt
);
6820 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6823 /* Get specified width, and height. */
6824 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6825 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6826 xassert (img
->width
> 0 && img
->height
> 0);
6830 if (fmt
[XBM_ASCENT
].count
)
6831 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6833 /* Get foreground and background colors, maybe allocate colors. */
6834 if (fmt
[XBM_FOREGROUND
].count
)
6835 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6837 if (fmt
[XBM_BACKGROUND
].count
)
6838 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6841 /* Set bits to the bitmap image data. */
6842 data
= fmt
[XBM_DATA
].value
;
6847 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6849 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6850 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6852 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6854 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6856 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6859 else if (STRINGP (data
))
6860 bits
= XSTRING (data
)->data
;
6862 bits
= XBOOL_VECTOR (data
)->data
;
6864 /* Create the pixmap. */
6865 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6867 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6870 img
->width
, img
->height
,
6871 foreground
, background
,
6877 image_error ("Unable to create pixmap for XBM image `%s'",
6879 x_clear_image (f
, img
);
6890 /***********************************************************************
6892 ***********************************************************************/
6896 static int xpm_image_p
P_ ((Lisp_Object object
));
6897 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6898 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6900 #include "X11/xpm.h"
6902 /* The symbol `xpm' identifying XPM-format images. */
6906 /* Indices of image specification fields in xpm_format, below. */
6908 enum xpm_keyword_index
6922 /* Vector of image_keyword structures describing the format
6923 of valid XPM image specifications. */
6925 static struct image_keyword xpm_format
[XPM_LAST
] =
6927 {":type", IMAGE_SYMBOL_VALUE
, 1},
6928 {":file", IMAGE_STRING_VALUE
, 0},
6929 {":data", IMAGE_STRING_VALUE
, 0},
6930 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6931 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6932 {":relief", IMAGE_INTEGER_VALUE
, 0},
6933 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6934 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6935 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6938 /* Structure describing the image type XBM. */
6940 static struct image_type xpm_type
=
6950 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6951 for XPM images. Such a list must consist of conses whose car and
6955 xpm_valid_color_symbols_p (color_symbols
)
6956 Lisp_Object color_symbols
;
6958 while (CONSP (color_symbols
))
6960 Lisp_Object sym
= XCAR (color_symbols
);
6962 || !STRINGP (XCAR (sym
))
6963 || !STRINGP (XCDR (sym
)))
6965 color_symbols
= XCDR (color_symbols
);
6968 return NILP (color_symbols
);
6972 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6975 xpm_image_p (object
)
6978 struct image_keyword fmt
[XPM_LAST
];
6979 bcopy (xpm_format
, fmt
, sizeof fmt
);
6980 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6981 /* Either `:file' or `:data' must be present. */
6982 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6983 /* Either no `:color-symbols' or it's a list of conses
6984 whose car and cdr are strings. */
6985 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6986 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6987 && (fmt
[XPM_ASCENT
].count
== 0
6988 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6992 /* Load image IMG which will be displayed on frame F. Value is
6993 non-zero if successful. */
7001 XpmAttributes attrs
;
7002 Lisp_Object specified_file
, color_symbols
;
7004 /* Configure the XPM lib. Use the visual of frame F. Allocate
7005 close colors. Return colors allocated. */
7006 bzero (&attrs
, sizeof attrs
);
7007 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7008 attrs
.valuemask
|= XpmVisual
;
7009 attrs
.valuemask
|= XpmReturnAllocPixels
;
7010 #ifdef XpmAllocCloseColors
7011 attrs
.alloc_close_colors
= 1;
7012 attrs
.valuemask
|= XpmAllocCloseColors
;
7014 attrs
.closeness
= 600;
7015 attrs
.valuemask
|= XpmCloseness
;
7018 /* If image specification contains symbolic color definitions, add
7019 these to `attrs'. */
7020 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7021 if (CONSP (color_symbols
))
7024 XpmColorSymbol
*xpm_syms
;
7027 attrs
.valuemask
|= XpmColorSymbols
;
7029 /* Count number of symbols. */
7030 attrs
.numsymbols
= 0;
7031 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7034 /* Allocate an XpmColorSymbol array. */
7035 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7036 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7037 bzero (xpm_syms
, size
);
7038 attrs
.colorsymbols
= xpm_syms
;
7040 /* Fill the color symbol array. */
7041 for (tail
= color_symbols
, i
= 0;
7043 ++i
, tail
= XCDR (tail
))
7045 Lisp_Object name
= XCAR (XCAR (tail
));
7046 Lisp_Object color
= XCDR (XCAR (tail
));
7047 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7048 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7049 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7050 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7054 /* Create a pixmap for the image, either from a file, or from a
7055 string buffer containing data in the same format as an XPM file. */
7057 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7058 if (STRINGP (specified_file
))
7060 Lisp_Object file
= x_find_image_file (specified_file
);
7061 if (!STRINGP (file
))
7063 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7068 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7069 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7074 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7075 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7076 XSTRING (buffer
)->data
,
7077 &img
->pixmap
, &img
->mask
,
7082 if (rc
== XpmSuccess
)
7084 /* Remember allocated colors. */
7085 img
->ncolors
= attrs
.nalloc_pixels
;
7086 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7087 * sizeof *img
->colors
);
7088 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7089 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7091 img
->width
= attrs
.width
;
7092 img
->height
= attrs
.height
;
7093 xassert (img
->width
> 0 && img
->height
> 0);
7095 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7097 XpmFreeAttributes (&attrs
);
7105 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7108 case XpmFileInvalid
:
7109 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7113 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7116 case XpmColorFailed
:
7117 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7121 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7126 return rc
== XpmSuccess
;
7129 #endif /* HAVE_XPM != 0 */
7132 /***********************************************************************
7134 ***********************************************************************/
7136 /* An entry in the color table mapping an RGB color to a pixel color. */
7141 unsigned long pixel
;
7143 /* Next in color table collision list. */
7144 struct ct_color
*next
;
7147 /* The bucket vector size to use. Must be prime. */
7151 /* Value is a hash of the RGB color given by R, G, and B. */
7153 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7155 /* The color hash table. */
7157 struct ct_color
**ct_table
;
7159 /* Number of entries in the color table. */
7161 int ct_colors_allocated
;
7163 /* Function prototypes. */
7165 static void init_color_table
P_ ((void));
7166 static void free_color_table
P_ ((void));
7167 static unsigned long *colors_in_color_table
P_ ((int *n
));
7168 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7169 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7172 /* Initialize the color table. */
7177 int size
= CT_SIZE
* sizeof (*ct_table
);
7178 ct_table
= (struct ct_color
**) xmalloc (size
);
7179 bzero (ct_table
, size
);
7180 ct_colors_allocated
= 0;
7184 /* Free memory associated with the color table. */
7190 struct ct_color
*p
, *next
;
7192 for (i
= 0; i
< CT_SIZE
; ++i
)
7193 for (p
= ct_table
[i
]; p
; p
= next
)
7204 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7205 entry for that color already is in the color table, return the
7206 pixel color of that entry. Otherwise, allocate a new color for R,
7207 G, B, and make an entry in the color table. */
7209 static unsigned long
7210 lookup_rgb_color (f
, r
, g
, b
)
7214 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7215 int i
= hash
% CT_SIZE
;
7218 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7219 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7233 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7234 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7239 ++ct_colors_allocated
;
7241 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7245 p
->pixel
= color
.pixel
;
7246 p
->next
= ct_table
[i
];
7250 return FRAME_FOREGROUND_PIXEL (f
);
7257 /* Look up pixel color PIXEL which is used on frame F in the color
7258 table. If not already present, allocate it. Value is PIXEL. */
7260 static unsigned long
7261 lookup_pixel_color (f
, pixel
)
7263 unsigned long pixel
;
7265 int i
= pixel
% CT_SIZE
;
7268 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7269 if (p
->pixel
== pixel
)
7280 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7281 color
.pixel
= pixel
;
7282 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7283 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7288 ++ct_colors_allocated
;
7290 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7295 p
->next
= ct_table
[i
];
7299 return FRAME_FOREGROUND_PIXEL (f
);
7306 /* Value is a vector of all pixel colors contained in the color table,
7307 allocated via xmalloc. Set *N to the number of colors. */
7309 static unsigned long *
7310 colors_in_color_table (n
)
7315 unsigned long *colors
;
7317 if (ct_colors_allocated
== 0)
7324 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7326 *n
= ct_colors_allocated
;
7328 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7329 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7330 colors
[j
++] = p
->pixel
;
7338 /***********************************************************************
7340 ***********************************************************************/
7342 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7343 int, XImage
*, int));
7344 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7345 XColor
*, int, XImage
*, int));
7348 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7349 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7350 the width of one row in the image. */
7353 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7363 for (x
= 0; x
< width
; ++x
)
7364 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7366 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7370 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7371 containing the pixel colors to write. F is the frame we are
7375 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7384 for (x
= 0; x
< width
; ++x
)
7385 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7389 /* Transform image IMG which is used on frame F with a Laplace
7390 edge-detection algorithm. The result is an image that can be used
7391 to draw disabled buttons, for example. */
7398 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7399 XImage
*ximg
, *oimg
;
7405 int in_y
, out_y
, rc
;
7410 /* Get the X image IMG->pixmap. */
7411 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7412 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7414 /* Allocate 3 input rows, and one output row of colors. */
7415 for (i
= 0; i
< 3; ++i
)
7416 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7417 out
= (long *) alloca (img
->width
* sizeof (long));
7419 /* Create an X image for output. */
7420 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7423 /* Fill first two rows. */
7424 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7425 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7428 /* Write first row, all zeros. */
7429 init_color_table ();
7430 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7431 for (x
= 0; x
< img
->width
; ++x
)
7433 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7436 for (y
= 2; y
< img
->height
; ++y
)
7439 int rowb
= (y
+ 2) % 3;
7441 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7443 for (x
= 0; x
< img
->width
- 2; ++x
)
7445 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7446 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7447 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7449 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7453 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7456 /* Write last line, all zeros. */
7457 for (x
= 0; x
< img
->width
; ++x
)
7459 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7461 /* Free the input image, and free resources of IMG. */
7462 XDestroyImage (ximg
);
7463 x_clear_image (f
, img
);
7465 /* Put the output image into pixmap, and destroy it. */
7466 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7467 x_destroy_x_image (oimg
);
7469 /* Remember new pixmap and colors in IMG. */
7470 img
->pixmap
= pixmap
;
7471 img
->colors
= colors_in_color_table (&img
->ncolors
);
7472 free_color_table ();
7478 /* Build a mask for image IMG which is used on frame F. FILE is the
7479 name of an image file, for error messages. HOW determines how to
7480 determine the background color of IMG. If it is a list '(R G B)',
7481 with R, G, and B being integers >= 0, take that as the color of the
7482 background. Otherwise, determine the background color of IMG
7483 heuristically. Value is non-zero if successful. */
7486 x_build_heuristic_mask (f
, img
, how
)
7491 Display
*dpy
= FRAME_X_DISPLAY (f
);
7492 XImage
*ximg
, *mask_img
;
7493 int x
, y
, rc
, look_at_corners_p
;
7498 /* Create an image and pixmap serving as mask. */
7499 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7500 &mask_img
, &img
->mask
);
7507 /* Get the X image of IMG->pixmap. */
7508 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7511 /* Determine the background color of ximg. If HOW is `(R G B)'
7512 take that as color. Otherwise, try to determine the color
7514 look_at_corners_p
= 1;
7522 && NATNUMP (XCAR (how
)))
7524 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7528 if (i
== 3 && NILP (how
))
7530 char color_name
[30];
7531 XColor exact
, color
;
7534 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7536 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7537 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7540 look_at_corners_p
= 0;
7545 if (look_at_corners_p
)
7547 unsigned long corners
[4];
7550 /* Get the colors at the corners of ximg. */
7551 corners
[0] = XGetPixel (ximg
, 0, 0);
7552 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7553 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7554 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7556 /* Choose the most frequently found color as background. */
7557 for (i
= best_count
= 0; i
< 4; ++i
)
7561 for (j
= n
= 0; j
< 4; ++j
)
7562 if (corners
[i
] == corners
[j
])
7566 bg
= corners
[i
], best_count
= n
;
7570 /* Set all bits in mask_img to 1 whose color in ximg is different
7571 from the background color bg. */
7572 for (y
= 0; y
< img
->height
; ++y
)
7573 for (x
= 0; x
< img
->width
; ++x
)
7574 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7576 /* Put mask_img into img->mask. */
7577 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7578 x_destroy_x_image (mask_img
);
7579 XDestroyImage (ximg
);
7587 /***********************************************************************
7588 PBM (mono, gray, color)
7589 ***********************************************************************/
7591 static int pbm_image_p
P_ ((Lisp_Object object
));
7592 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7593 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7595 /* The symbol `pbm' identifying images of this type. */
7599 /* Indices of image specification fields in gs_format, below. */
7601 enum pbm_keyword_index
7614 /* Vector of image_keyword structures describing the format
7615 of valid user-defined image specifications. */
7617 static struct image_keyword pbm_format
[PBM_LAST
] =
7619 {":type", IMAGE_SYMBOL_VALUE
, 1},
7620 {":file", IMAGE_STRING_VALUE
, 0},
7621 {":data", IMAGE_STRING_VALUE
, 0},
7622 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7623 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7624 {":relief", IMAGE_INTEGER_VALUE
, 0},
7625 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7626 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7629 /* Structure describing the image type `pbm'. */
7631 static struct image_type pbm_type
=
7641 /* Return non-zero if OBJECT is a valid PBM image specification. */
7644 pbm_image_p (object
)
7647 struct image_keyword fmt
[PBM_LAST
];
7649 bcopy (pbm_format
, fmt
, sizeof fmt
);
7651 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7652 || (fmt
[PBM_ASCENT
].count
7653 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7656 /* Must specify either :data or :file. */
7657 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7661 /* Scan a decimal number from *S and return it. Advance *S while
7662 reading the number. END is the end of the string. Value is -1 at
7666 pbm_scan_number (s
, end
)
7667 unsigned char **s
, *end
;
7673 /* Skip white-space. */
7674 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7679 /* Skip comment to end of line. */
7680 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7683 else if (isdigit (c
))
7685 /* Read decimal number. */
7687 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7688 val
= 10 * val
+ c
- '0';
7699 /* Read FILE into memory. Value is a pointer to a buffer allocated
7700 with xmalloc holding FILE's contents. Value is null if an error
7701 occured. *SIZE is set to the size of the file. */
7704 pbm_read_file (file
, size
)
7712 if (stat (XSTRING (file
)->data
, &st
) == 0
7713 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
7714 && (buf
= (char *) xmalloc (st
.st_size
),
7715 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
7735 /* Load PBM image IMG for use on frame F. */
7743 int width
, height
, max_color_idx
= 0;
7745 Lisp_Object file
, specified_file
;
7746 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7747 struct gcpro gcpro1
;
7748 unsigned char *contents
= NULL
;
7749 unsigned char *end
, *p
;
7752 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7756 if (STRINGP (specified_file
))
7758 file
= x_find_image_file (specified_file
);
7759 if (!STRINGP (file
))
7761 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7766 contents
= pbm_read_file (file
, &size
);
7767 if (contents
== NULL
)
7769 image_error ("Error reading `%s'", file
, Qnil
);
7775 end
= contents
+ size
;
7780 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7781 p
= XSTRING (data
)->data
;
7782 end
= p
+ STRING_BYTES (XSTRING (data
));
7785 /* Check magic number. */
7786 if (end
- p
< 2 || *p
++ != 'P')
7788 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7798 raw_p
= 0, type
= PBM_MONO
;
7802 raw_p
= 0, type
= PBM_GRAY
;
7806 raw_p
= 0, type
= PBM_COLOR
;
7810 raw_p
= 1, type
= PBM_MONO
;
7814 raw_p
= 1, type
= PBM_GRAY
;
7818 raw_p
= 1, type
= PBM_COLOR
;
7822 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7826 /* Read width, height, maximum color-component. Characters
7827 starting with `#' up to the end of a line are ignored. */
7828 width
= pbm_scan_number (&p
, end
);
7829 height
= pbm_scan_number (&p
, end
);
7831 if (type
!= PBM_MONO
)
7833 max_color_idx
= pbm_scan_number (&p
, end
);
7834 if (raw_p
&& max_color_idx
> 255)
7835 max_color_idx
= 255;
7840 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7844 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7845 &ximg
, &img
->pixmap
))
7851 /* Initialize the color hash table. */
7852 init_color_table ();
7854 if (type
== PBM_MONO
)
7858 for (y
= 0; y
< height
; ++y
)
7859 for (x
= 0; x
< width
; ++x
)
7869 g
= pbm_scan_number (&p
, end
);
7871 XPutPixel (ximg
, x
, y
, (g
7872 ? FRAME_FOREGROUND_PIXEL (f
)
7873 : FRAME_BACKGROUND_PIXEL (f
)));
7878 for (y
= 0; y
< height
; ++y
)
7879 for (x
= 0; x
< width
; ++x
)
7883 if (type
== PBM_GRAY
)
7884 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7893 r
= pbm_scan_number (&p
, end
);
7894 g
= pbm_scan_number (&p
, end
);
7895 b
= pbm_scan_number (&p
, end
);
7898 if (r
< 0 || g
< 0 || b
< 0)
7902 XDestroyImage (ximg
);
7904 image_error ("Invalid pixel value in image `%s'",
7909 /* RGB values are now in the range 0..max_color_idx.
7910 Scale this to the range 0..0xffff supported by X. */
7911 r
= (double) r
* 65535 / max_color_idx
;
7912 g
= (double) g
* 65535 / max_color_idx
;
7913 b
= (double) b
* 65535 / max_color_idx
;
7914 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7918 /* Store in IMG->colors the colors allocated for the image, and
7919 free the color table. */
7920 img
->colors
= colors_in_color_table (&img
->ncolors
);
7921 free_color_table ();
7923 /* Put the image into a pixmap. */
7924 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7925 x_destroy_x_image (ximg
);
7929 img
->height
= height
;
7938 /***********************************************************************
7940 ***********************************************************************/
7946 /* Function prototypes. */
7948 static int png_image_p
P_ ((Lisp_Object object
));
7949 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7951 /* The symbol `png' identifying images of this type. */
7955 /* Indices of image specification fields in png_format, below. */
7957 enum png_keyword_index
7970 /* Vector of image_keyword structures describing the format
7971 of valid user-defined image specifications. */
7973 static struct image_keyword png_format
[PNG_LAST
] =
7975 {":type", IMAGE_SYMBOL_VALUE
, 1},
7976 {":data", IMAGE_STRING_VALUE
, 0},
7977 {":file", IMAGE_STRING_VALUE
, 0},
7978 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7979 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7980 {":relief", IMAGE_INTEGER_VALUE
, 0},
7981 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7982 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7985 /* Structure describing the image type `png'. */
7987 static struct image_type png_type
=
7997 /* Return non-zero if OBJECT is a valid PNG image specification. */
8000 png_image_p (object
)
8003 struct image_keyword fmt
[PNG_LAST
];
8004 bcopy (png_format
, fmt
, sizeof fmt
);
8006 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
8007 || (fmt
[PNG_ASCENT
].count
8008 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
8011 /* Must specify either the :data or :file keyword. */
8012 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8016 /* Error and warning handlers installed when the PNG library
8020 my_png_error (png_ptr
, msg
)
8021 png_struct
*png_ptr
;
8024 xassert (png_ptr
!= NULL
);
8025 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8026 longjmp (png_ptr
->jmpbuf
, 1);
8031 my_png_warning (png_ptr
, msg
)
8032 png_struct
*png_ptr
;
8035 xassert (png_ptr
!= NULL
);
8036 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8039 /* Memory source for PNG decoding. */
8041 struct png_memory_storage
8043 unsigned char *bytes
; /* The data */
8044 size_t len
; /* How big is it? */
8045 int index
; /* Where are we? */
8049 /* Function set as reader function when reading PNG image from memory.
8050 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8051 bytes from the input to DATA. */
8054 png_read_from_memory (png_ptr
, data
, length
)
8055 png_structp png_ptr
;
8059 struct png_memory_storage
*tbr
8060 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8062 if (length
> tbr
->len
- tbr
->index
)
8063 png_error (png_ptr
, "Read error");
8065 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8066 tbr
->index
= tbr
->index
+ length
;
8069 /* Load PNG image IMG for use on frame F. Value is non-zero if
8077 Lisp_Object file
, specified_file
;
8078 Lisp_Object specified_data
;
8080 XImage
*ximg
, *mask_img
= NULL
;
8081 struct gcpro gcpro1
;
8082 png_struct
*png_ptr
= NULL
;
8083 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8086 png_byte
*pixels
= NULL
;
8087 png_byte
**rows
= NULL
;
8088 png_uint_32 width
, height
;
8089 int bit_depth
, color_type
, interlace_type
;
8091 png_uint_32 row_bytes
;
8094 double screen_gamma
, image_gamma
;
8096 struct png_memory_storage tbr
; /* Data to be read */
8098 /* Find out what file to load. */
8099 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8100 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8104 if (NILP (specified_data
))
8106 file
= x_find_image_file (specified_file
);
8107 if (!STRINGP (file
))
8109 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8114 /* Open the image file. */
8115 fp
= fopen (XSTRING (file
)->data
, "rb");
8118 image_error ("Cannot open image file `%s'", file
, Qnil
);
8124 /* Check PNG signature. */
8125 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8126 || !png_check_sig (sig
, sizeof sig
))
8128 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8136 /* Read from memory. */
8137 tbr
.bytes
= XSTRING (specified_data
)->data
;
8138 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8141 /* Check PNG signature. */
8142 if (tbr
.len
< sizeof sig
8143 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8145 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8150 /* Need to skip past the signature. */
8151 tbr
.bytes
+= sizeof (sig
);
8154 /* Initialize read and info structs for PNG lib. */
8155 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8156 my_png_error
, my_png_warning
);
8159 if (fp
) fclose (fp
);
8164 info_ptr
= png_create_info_struct (png_ptr
);
8167 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8168 if (fp
) fclose (fp
);
8173 end_info
= png_create_info_struct (png_ptr
);
8176 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8177 if (fp
) fclose (fp
);
8182 /* Set error jump-back. We come back here when the PNG library
8183 detects an error. */
8184 if (setjmp (png_ptr
->jmpbuf
))
8188 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8191 if (fp
) fclose (fp
);
8196 /* Read image info. */
8197 if (!NILP (specified_data
))
8198 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8200 png_init_io (png_ptr
, fp
);
8202 png_set_sig_bytes (png_ptr
, sizeof sig
);
8203 png_read_info (png_ptr
, info_ptr
);
8204 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8205 &interlace_type
, NULL
, NULL
);
8207 /* If image contains simply transparency data, we prefer to
8208 construct a clipping mask. */
8209 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8214 /* This function is easier to write if we only have to handle
8215 one data format: RGB or RGBA with 8 bits per channel. Let's
8216 transform other formats into that format. */
8218 /* Strip more than 8 bits per channel. */
8219 if (bit_depth
== 16)
8220 png_set_strip_16 (png_ptr
);
8222 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8224 png_set_expand (png_ptr
);
8226 /* Convert grayscale images to RGB. */
8227 if (color_type
== PNG_COLOR_TYPE_GRAY
8228 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8229 png_set_gray_to_rgb (png_ptr
);
8231 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8232 gamma_str
= getenv ("SCREEN_GAMMA");
8233 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8235 /* Tell the PNG lib to handle gamma correction for us. */
8237 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8238 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8239 /* There is a special chunk in the image specifying the gamma. */
8240 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8243 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8244 /* Image contains gamma information. */
8245 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8247 /* Use a default of 0.5 for the image gamma. */
8248 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8250 /* Handle alpha channel by combining the image with a background
8251 color. Do this only if a real alpha channel is supplied. For
8252 simple transparency, we prefer a clipping mask. */
8255 png_color_16
*image_background
;
8257 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8258 /* Image contains a background color with which to
8259 combine the image. */
8260 png_set_background (png_ptr
, image_background
,
8261 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8264 /* Image does not contain a background color with which
8265 to combine the image data via an alpha channel. Use
8266 the frame's background instead. */
8269 png_color_16 frame_background
;
8272 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8273 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8274 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8277 bzero (&frame_background
, sizeof frame_background
);
8278 frame_background
.red
= color
.red
;
8279 frame_background
.green
= color
.green
;
8280 frame_background
.blue
= color
.blue
;
8282 png_set_background (png_ptr
, &frame_background
,
8283 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8287 /* Update info structure. */
8288 png_read_update_info (png_ptr
, info_ptr
);
8290 /* Get number of channels. Valid values are 1 for grayscale images
8291 and images with a palette, 2 for grayscale images with transparency
8292 information (alpha channel), 3 for RGB images, and 4 for RGB
8293 images with alpha channel, i.e. RGBA. If conversions above were
8294 sufficient we should only have 3 or 4 channels here. */
8295 channels
= png_get_channels (png_ptr
, info_ptr
);
8296 xassert (channels
== 3 || channels
== 4);
8298 /* Number of bytes needed for one row of the image. */
8299 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8301 /* Allocate memory for the image. */
8302 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8303 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8304 for (i
= 0; i
< height
; ++i
)
8305 rows
[i
] = pixels
+ i
* row_bytes
;
8307 /* Read the entire image. */
8308 png_read_image (png_ptr
, rows
);
8309 png_read_end (png_ptr
, info_ptr
);
8318 /* Create the X image and pixmap. */
8319 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8326 /* Create an image and pixmap serving as mask if the PNG image
8327 contains an alpha channel. */
8330 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8331 &mask_img
, &img
->mask
))
8333 x_destroy_x_image (ximg
);
8334 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8340 /* Fill the X image and mask from PNG data. */
8341 init_color_table ();
8343 for (y
= 0; y
< height
; ++y
)
8345 png_byte
*p
= rows
[y
];
8347 for (x
= 0; x
< width
; ++x
)
8354 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8356 /* An alpha channel, aka mask channel, associates variable
8357 transparency with an image. Where other image formats
8358 support binary transparency---fully transparent or fully
8359 opaque---PNG allows up to 254 levels of partial transparency.
8360 The PNG library implements partial transparency by combining
8361 the image with a specified background color.
8363 I'm not sure how to handle this here nicely: because the
8364 background on which the image is displayed may change, for
8365 real alpha channel support, it would be necessary to create
8366 a new image for each possible background.
8368 What I'm doing now is that a mask is created if we have
8369 boolean transparency information. Otherwise I'm using
8370 the frame's background color to combine the image with. */
8375 XPutPixel (mask_img
, x
, y
, *p
> 0);
8381 /* Remember colors allocated for this image. */
8382 img
->colors
= colors_in_color_table (&img
->ncolors
);
8383 free_color_table ();
8386 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8391 img
->height
= height
;
8393 /* Put the image into the pixmap, then free the X image and its buffer. */
8394 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8395 x_destroy_x_image (ximg
);
8397 /* Same for the mask. */
8400 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8401 x_destroy_x_image (mask_img
);
8409 #endif /* HAVE_PNG != 0 */
8413 /***********************************************************************
8415 ***********************************************************************/
8419 /* Work around a warning about HAVE_STDLIB_H being redefined in
8421 #ifdef HAVE_STDLIB_H
8422 #define HAVE_STDLIB_H_1
8423 #undef HAVE_STDLIB_H
8424 #endif /* HAVE_STLIB_H */
8426 #include <jpeglib.h>
8430 #ifdef HAVE_STLIB_H_1
8431 #define HAVE_STDLIB_H 1
8434 static int jpeg_image_p
P_ ((Lisp_Object object
));
8435 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8437 /* The symbol `jpeg' identifying images of this type. */
8441 /* Indices of image specification fields in gs_format, below. */
8443 enum jpeg_keyword_index
8452 JPEG_HEURISTIC_MASK
,
8456 /* Vector of image_keyword structures describing the format
8457 of valid user-defined image specifications. */
8459 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8461 {":type", IMAGE_SYMBOL_VALUE
, 1},
8462 {":data", IMAGE_STRING_VALUE
, 0},
8463 {":file", IMAGE_STRING_VALUE
, 0},
8464 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8465 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8466 {":relief", IMAGE_INTEGER_VALUE
, 0},
8467 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8468 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8471 /* Structure describing the image type `jpeg'. */
8473 static struct image_type jpeg_type
=
8483 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8486 jpeg_image_p (object
)
8489 struct image_keyword fmt
[JPEG_LAST
];
8491 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8493 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
8494 || (fmt
[JPEG_ASCENT
].count
8495 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8498 /* Must specify either the :data or :file keyword. */
8499 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8503 struct my_jpeg_error_mgr
8505 struct jpeg_error_mgr pub
;
8506 jmp_buf setjmp_buffer
;
8510 my_error_exit (cinfo
)
8513 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8514 longjmp (mgr
->setjmp_buffer
, 1);
8517 /* Init source method for JPEG data source manager. Called by
8518 jpeg_read_header() before any data is actually read. See
8519 libjpeg.doc from the JPEG lib distribution. */
8522 our_init_source (cinfo
)
8523 j_decompress_ptr cinfo
;
8528 /* Fill input buffer method for JPEG data source manager. Called
8529 whenever more data is needed. We read the whole image in one step,
8530 so this only adds a fake end of input marker at the end. */
8533 our_fill_input_buffer (cinfo
)
8534 j_decompress_ptr cinfo
;
8536 /* Insert a fake EOI marker. */
8537 struct jpeg_source_mgr
*src
= cinfo
->src
;
8538 static JOCTET buffer
[2];
8540 buffer
[0] = (JOCTET
) 0xFF;
8541 buffer
[1] = (JOCTET
) JPEG_EOI
;
8543 src
->next_input_byte
= buffer
;
8544 src
->bytes_in_buffer
= 2;
8549 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8550 is the JPEG data source manager. */
8553 our_skip_input_data (cinfo
, num_bytes
)
8554 j_decompress_ptr cinfo
;
8557 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8561 if (num_bytes
> src
->bytes_in_buffer
)
8562 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8564 src
->bytes_in_buffer
-= num_bytes
;
8565 src
->next_input_byte
+= num_bytes
;
8570 /* Method to terminate data source. Called by
8571 jpeg_finish_decompress() after all data has been processed. */
8574 our_term_source (cinfo
)
8575 j_decompress_ptr cinfo
;
8580 /* Set up the JPEG lib for reading an image from DATA which contains
8581 LEN bytes. CINFO is the decompression info structure created for
8582 reading the image. */
8585 jpeg_memory_src (cinfo
, data
, len
)
8586 j_decompress_ptr cinfo
;
8590 struct jpeg_source_mgr
*src
;
8592 if (cinfo
->src
== NULL
)
8594 /* First time for this JPEG object? */
8595 cinfo
->src
= (struct jpeg_source_mgr
*)
8596 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8597 sizeof (struct jpeg_source_mgr
));
8598 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8599 src
->next_input_byte
= data
;
8602 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8603 src
->init_source
= our_init_source
;
8604 src
->fill_input_buffer
= our_fill_input_buffer
;
8605 src
->skip_input_data
= our_skip_input_data
;
8606 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8607 src
->term_source
= our_term_source
;
8608 src
->bytes_in_buffer
= len
;
8609 src
->next_input_byte
= data
;
8613 /* Load image IMG for use on frame F. Patterned after example.c
8614 from the JPEG lib. */
8621 struct jpeg_decompress_struct cinfo
;
8622 struct my_jpeg_error_mgr mgr
;
8623 Lisp_Object file
, specified_file
;
8624 Lisp_Object specified_data
;
8627 int row_stride
, x
, y
;
8628 XImage
*ximg
= NULL
;
8630 unsigned long *colors
;
8632 struct gcpro gcpro1
;
8634 /* Open the JPEG file. */
8635 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8636 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8640 if (NILP (specified_data
))
8642 file
= x_find_image_file (specified_file
);
8643 if (!STRINGP (file
))
8645 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8650 fp
= fopen (XSTRING (file
)->data
, "r");
8653 image_error ("Cannot open `%s'", file
, Qnil
);
8659 /* Customize libjpeg's error handling to call my_error_exit when an
8660 error is detected. This function will perform a longjmp. */
8661 mgr
.pub
.error_exit
= my_error_exit
;
8662 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8664 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8668 /* Called from my_error_exit. Display a JPEG error. */
8669 char buffer
[JMSG_LENGTH_MAX
];
8670 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8671 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8672 build_string (buffer
));
8675 /* Close the input file and destroy the JPEG object. */
8678 jpeg_destroy_decompress (&cinfo
);
8682 /* If we already have an XImage, free that. */
8683 x_destroy_x_image (ximg
);
8685 /* Free pixmap and colors. */
8686 x_clear_image (f
, img
);
8693 /* Create the JPEG decompression object. Let it read from fp.
8694 Read the JPEG image header. */
8695 jpeg_create_decompress (&cinfo
);
8697 if (NILP (specified_data
))
8698 jpeg_stdio_src (&cinfo
, fp
);
8700 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8701 STRING_BYTES (XSTRING (specified_data
)));
8703 jpeg_read_header (&cinfo
, TRUE
);
8705 /* Customize decompression so that color quantization will be used.
8706 Start decompression. */
8707 cinfo
.quantize_colors
= TRUE
;
8708 jpeg_start_decompress (&cinfo
);
8709 width
= img
->width
= cinfo
.output_width
;
8710 height
= img
->height
= cinfo
.output_height
;
8714 /* Create X image and pixmap. */
8715 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8718 longjmp (mgr
.setjmp_buffer
, 2);
8721 /* Allocate colors. When color quantization is used,
8722 cinfo.actual_number_of_colors has been set with the number of
8723 colors generated, and cinfo.colormap is a two-dimensional array
8724 of color indices in the range 0..cinfo.actual_number_of_colors.
8725 No more than 255 colors will be generated. */
8729 if (cinfo
.out_color_components
> 2)
8730 ir
= 0, ig
= 1, ib
= 2;
8731 else if (cinfo
.out_color_components
> 1)
8732 ir
= 0, ig
= 1, ib
= 0;
8734 ir
= 0, ig
= 0, ib
= 0;
8736 /* Use the color table mechanism because it handles colors that
8737 cannot be allocated nicely. Such colors will be replaced with
8738 a default color, and we don't have to care about which colors
8739 can be freed safely, and which can't. */
8740 init_color_table ();
8741 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8744 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8746 /* Multiply RGB values with 255 because X expects RGB values
8747 in the range 0..0xffff. */
8748 int r
= cinfo
.colormap
[ir
][i
] << 8;
8749 int g
= cinfo
.colormap
[ig
][i
] << 8;
8750 int b
= cinfo
.colormap
[ib
][i
] << 8;
8751 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8754 /* Remember those colors actually allocated. */
8755 img
->colors
= colors_in_color_table (&img
->ncolors
);
8756 free_color_table ();
8760 row_stride
= width
* cinfo
.output_components
;
8761 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8763 for (y
= 0; y
< height
; ++y
)
8765 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8766 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8767 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8771 jpeg_finish_decompress (&cinfo
);
8772 jpeg_destroy_decompress (&cinfo
);
8776 /* Put the image into the pixmap. */
8777 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8778 x_destroy_x_image (ximg
);
8784 #endif /* HAVE_JPEG */
8788 /***********************************************************************
8790 ***********************************************************************/
8796 static int tiff_image_p
P_ ((Lisp_Object object
));
8797 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8799 /* The symbol `tiff' identifying images of this type. */
8803 /* Indices of image specification fields in tiff_format, below. */
8805 enum tiff_keyword_index
8814 TIFF_HEURISTIC_MASK
,
8818 /* Vector of image_keyword structures describing the format
8819 of valid user-defined image specifications. */
8821 static struct image_keyword tiff_format
[TIFF_LAST
] =
8823 {":type", IMAGE_SYMBOL_VALUE
, 1},
8824 {":data", IMAGE_STRING_VALUE
, 0},
8825 {":file", IMAGE_STRING_VALUE
, 0},
8826 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8827 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8828 {":relief", IMAGE_INTEGER_VALUE
, 0},
8829 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8830 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8833 /* Structure describing the image type `tiff'. */
8835 static struct image_type tiff_type
=
8845 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8848 tiff_image_p (object
)
8851 struct image_keyword fmt
[TIFF_LAST
];
8852 bcopy (tiff_format
, fmt
, sizeof fmt
);
8854 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
8855 || (fmt
[TIFF_ASCENT
].count
8856 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8859 /* Must specify either the :data or :file keyword. */
8860 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8864 /* Reading from a memory buffer for TIFF images Based on the PNG
8865 memory source, but we have to provide a lot of extra functions.
8868 We really only need to implement read and seek, but I am not
8869 convinced that the TIFF library is smart enough not to destroy
8870 itself if we only hand it the function pointers we need to
8875 unsigned char *bytes
;
8882 tiff_read_from_memory (data
, buf
, size
)
8887 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8889 if (size
> src
->len
- src
->index
)
8891 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8897 tiff_write_from_memory (data
, buf
, size
)
8906 tiff_seek_in_memory (data
, off
, whence
)
8911 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8916 case SEEK_SET
: /* Go from beginning of source. */
8920 case SEEK_END
: /* Go from end of source. */
8921 idx
= src
->len
+ off
;
8924 case SEEK_CUR
: /* Go from current position. */
8925 idx
= src
->index
+ off
;
8928 default: /* Invalid `whence'. */
8932 if (idx
> src
->len
|| idx
< 0)
8940 tiff_close_memory (data
)
8948 tiff_mmap_memory (data
, pbase
, psize
)
8953 /* It is already _IN_ memory. */
8958 tiff_unmap_memory (data
, base
, size
)
8963 /* We don't need to do this. */
8967 tiff_size_of_memory (data
)
8970 return ((tiff_memory_source
*) data
)->len
;
8973 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8981 Lisp_Object file
, specified_file
;
8982 Lisp_Object specified_data
;
8984 int width
, height
, x
, y
;
8988 struct gcpro gcpro1
;
8989 tiff_memory_source memsrc
;
8991 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8992 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8996 if (NILP (specified_data
))
8998 /* Read from a file */
8999 file
= x_find_image_file (specified_file
);
9000 if (!STRINGP (file
))
9002 image_error ("Cannot find image file `%s'", file
, Qnil
);
9007 /* Try to open the image file. */
9008 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9011 image_error ("Cannot open `%s'", file
, Qnil
);
9018 /* Memory source! */
9019 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9020 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9023 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9024 (TIFFReadWriteProc
) tiff_read_from_memory
,
9025 (TIFFReadWriteProc
) tiff_write_from_memory
,
9026 tiff_seek_in_memory
,
9028 tiff_size_of_memory
,
9034 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9040 /* Get width and height of the image, and allocate a raster buffer
9041 of width x height 32-bit values. */
9042 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9043 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9044 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9046 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9050 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9058 /* Create the X image and pixmap. */
9059 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9067 /* Initialize the color table. */
9068 init_color_table ();
9070 /* Process the pixel raster. Origin is in the lower-left corner. */
9071 for (y
= 0; y
< height
; ++y
)
9073 uint32
*row
= buf
+ y
* width
;
9075 for (x
= 0; x
< width
; ++x
)
9077 uint32 abgr
= row
[x
];
9078 int r
= TIFFGetR (abgr
) << 8;
9079 int g
= TIFFGetG (abgr
) << 8;
9080 int b
= TIFFGetB (abgr
) << 8;
9081 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9085 /* Remember the colors allocated for the image. Free the color table. */
9086 img
->colors
= colors_in_color_table (&img
->ncolors
);
9087 free_color_table ();
9089 /* Put the image into the pixmap, then free the X image and its buffer. */
9090 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9091 x_destroy_x_image (ximg
);
9096 img
->height
= height
;
9102 #endif /* HAVE_TIFF != 0 */
9106 /***********************************************************************
9108 ***********************************************************************/
9112 #include <gif_lib.h>
9114 static int gif_image_p
P_ ((Lisp_Object object
));
9115 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9117 /* The symbol `gif' identifying images of this type. */
9121 /* Indices of image specification fields in gif_format, below. */
9123 enum gif_keyword_index
9137 /* Vector of image_keyword structures describing the format
9138 of valid user-defined image specifications. */
9140 static struct image_keyword gif_format
[GIF_LAST
] =
9142 {":type", IMAGE_SYMBOL_VALUE
, 1},
9143 {":data", IMAGE_STRING_VALUE
, 0},
9144 {":file", IMAGE_STRING_VALUE
, 0},
9145 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9146 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9147 {":relief", IMAGE_INTEGER_VALUE
, 0},
9148 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9149 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9150 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9153 /* Structure describing the image type `gif'. */
9155 static struct image_type gif_type
=
9164 /* Return non-zero if OBJECT is a valid GIF image specification. */
9167 gif_image_p (object
)
9170 struct image_keyword fmt
[GIF_LAST
];
9171 bcopy (gif_format
, fmt
, sizeof fmt
);
9173 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
9174 || (fmt
[GIF_ASCENT
].count
9175 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
9178 /* Must specify either the :data or :file keyword. */
9179 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9182 /* Reading a GIF image from memory
9183 Based on the PNG memory stuff to a certain extent. */
9187 unsigned char *bytes
;
9193 /* Make the current memory source available to gif_read_from_memory.
9194 It's done this way because not all versions of libungif support
9195 a UserData field in the GifFileType structure. */
9196 static gif_memory_source
*current_gif_memory_src
;
9199 gif_read_from_memory (file
, buf
, len
)
9204 gif_memory_source
*src
= current_gif_memory_src
;
9206 if (len
> src
->len
- src
->index
)
9209 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9215 /* Load GIF image IMG for use on frame F. Value is non-zero if
9223 Lisp_Object file
, specified_file
;
9224 Lisp_Object specified_data
;
9225 int rc
, width
, height
, x
, y
, i
;
9227 ColorMapObject
*gif_color_map
;
9228 unsigned long pixel_colors
[256];
9230 struct gcpro gcpro1
;
9232 int ino
, image_left
, image_top
, image_width
, image_height
;
9233 gif_memory_source memsrc
;
9234 unsigned char *raster
;
9236 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9237 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9241 if (NILP (specified_data
))
9243 file
= x_find_image_file (specified_file
);
9244 if (!STRINGP (file
))
9246 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9251 /* Open the GIF file. */
9252 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9255 image_error ("Cannot open `%s'", file
, Qnil
);
9262 /* Read from memory! */
9263 current_gif_memory_src
= &memsrc
;
9264 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9265 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9268 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9271 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9277 /* Read entire contents. */
9278 rc
= DGifSlurp (gif
);
9279 if (rc
== GIF_ERROR
)
9281 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9282 DGifCloseFile (gif
);
9287 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9288 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9289 if (ino
>= gif
->ImageCount
)
9291 image_error ("Invalid image number `%s' in image `%s'",
9293 DGifCloseFile (gif
);
9298 width
= img
->width
= gif
->SWidth
;
9299 height
= img
->height
= gif
->SHeight
;
9303 /* Create the X image and pixmap. */
9304 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9307 DGifCloseFile (gif
);
9312 /* Allocate colors. */
9313 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9315 gif_color_map
= gif
->SColorMap
;
9316 init_color_table ();
9317 bzero (pixel_colors
, sizeof pixel_colors
);
9319 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9321 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9322 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9323 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9324 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9327 img
->colors
= colors_in_color_table (&img
->ncolors
);
9328 free_color_table ();
9330 /* Clear the part of the screen image that are not covered by
9331 the image from the GIF file. Full animated GIF support
9332 requires more than can be done here (see the gif89 spec,
9333 disposal methods). Let's simply assume that the part
9334 not covered by a sub-image is in the frame's background color. */
9335 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9336 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9337 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9338 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9340 for (y
= 0; y
< image_top
; ++y
)
9341 for (x
= 0; x
< width
; ++x
)
9342 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9344 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9345 for (x
= 0; x
< width
; ++x
)
9346 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9348 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9350 for (x
= 0; x
< image_left
; ++x
)
9351 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9352 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9353 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9356 /* Read the GIF image into the X image. We use a local variable
9357 `raster' here because RasterBits below is a char *, and invites
9358 problems with bytes >= 0x80. */
9359 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9361 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9363 static int interlace_start
[] = {0, 4, 2, 1};
9364 static int interlace_increment
[] = {8, 8, 4, 2};
9366 int row
= interlace_start
[0];
9370 for (y
= 0; y
< image_height
; y
++)
9372 if (row
>= image_height
)
9374 row
= interlace_start
[++pass
];
9375 while (row
>= image_height
)
9376 row
= interlace_start
[++pass
];
9379 for (x
= 0; x
< image_width
; x
++)
9381 int i
= raster
[(y
* image_width
) + x
];
9382 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9386 row
+= interlace_increment
[pass
];
9391 for (y
= 0; y
< image_height
; ++y
)
9392 for (x
= 0; x
< image_width
; ++x
)
9394 int i
= raster
[y
* image_width
+ x
];
9395 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9399 DGifCloseFile (gif
);
9401 /* Put the image into the pixmap, then free the X image and its buffer. */
9402 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9403 x_destroy_x_image (ximg
);
9410 #endif /* HAVE_GIF != 0 */
9414 /***********************************************************************
9416 ***********************************************************************/
9418 static int gs_image_p
P_ ((Lisp_Object object
));
9419 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9420 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9422 /* The symbol `postscript' identifying images of this type. */
9424 Lisp_Object Qpostscript
;
9426 /* Keyword symbols. */
9428 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9430 /* Indices of image specification fields in gs_format, below. */
9432 enum gs_keyword_index
9448 /* Vector of image_keyword structures describing the format
9449 of valid user-defined image specifications. */
9451 static struct image_keyword gs_format
[GS_LAST
] =
9453 {":type", IMAGE_SYMBOL_VALUE
, 1},
9454 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9455 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9456 {":file", IMAGE_STRING_VALUE
, 1},
9457 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9458 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9459 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9460 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9461 {":relief", IMAGE_INTEGER_VALUE
, 0},
9462 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9463 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9466 /* Structure describing the image type `ghostscript'. */
9468 static struct image_type gs_type
=
9478 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9481 gs_clear_image (f
, img
)
9485 /* IMG->data.ptr_val may contain a recorded colormap. */
9486 xfree (img
->data
.ptr_val
);
9487 x_clear_image (f
, img
);
9491 /* Return non-zero if OBJECT is a valid Ghostscript image
9498 struct image_keyword fmt
[GS_LAST
];
9502 bcopy (gs_format
, fmt
, sizeof fmt
);
9504 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
9505 || (fmt
[GS_ASCENT
].count
9506 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9509 /* Bounding box must be a list or vector containing 4 integers. */
9510 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9513 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9514 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9519 else if (VECTORP (tem
))
9521 if (XVECTOR (tem
)->size
!= 4)
9523 for (i
= 0; i
< 4; ++i
)
9524 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9534 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9543 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9544 struct gcpro gcpro1
, gcpro2
;
9546 double in_width
, in_height
;
9547 Lisp_Object pixel_colors
= Qnil
;
9549 /* Compute pixel size of pixmap needed from the given size in the
9550 image specification. Sizes in the specification are in pt. 1 pt
9551 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9553 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9554 in_width
= XFASTINT (pt_width
) / 72.0;
9555 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9556 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9557 in_height
= XFASTINT (pt_height
) / 72.0;
9558 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9560 /* Create the pixmap. */
9562 xassert (img
->pixmap
== 0);
9563 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9564 img
->width
, img
->height
,
9565 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9570 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9574 /* Call the loader to fill the pixmap. It returns a process object
9575 if successful. We do not record_unwind_protect here because
9576 other places in redisplay like calling window scroll functions
9577 don't either. Let the Lisp loader use `unwind-protect' instead. */
9578 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9580 sprintf (buffer
, "%lu %lu",
9581 (unsigned long) FRAME_X_WINDOW (f
),
9582 (unsigned long) img
->pixmap
);
9583 window_and_pixmap_id
= build_string (buffer
);
9585 sprintf (buffer
, "%lu %lu",
9586 FRAME_FOREGROUND_PIXEL (f
),
9587 FRAME_BACKGROUND_PIXEL (f
));
9588 pixel_colors
= build_string (buffer
);
9590 XSETFRAME (frame
, f
);
9591 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9593 loader
= intern ("gs-load-image");
9595 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9596 make_number (img
->width
),
9597 make_number (img
->height
),
9598 window_and_pixmap_id
,
9601 return PROCESSP (img
->data
.lisp_val
);
9605 /* Kill the Ghostscript process that was started to fill PIXMAP on
9606 frame F. Called from XTread_socket when receiving an event
9607 telling Emacs that Ghostscript has finished drawing. */
9610 x_kill_gs_process (pixmap
, f
)
9614 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9618 /* Find the image containing PIXMAP. */
9619 for (i
= 0; i
< c
->used
; ++i
)
9620 if (c
->images
[i
]->pixmap
== pixmap
)
9623 /* Kill the GS process. We should have found PIXMAP in the image
9624 cache and its image should contain a process object. */
9625 xassert (i
< c
->used
);
9627 xassert (PROCESSP (img
->data
.lisp_val
));
9628 Fkill_process (img
->data
.lisp_val
, Qnil
);
9629 img
->data
.lisp_val
= Qnil
;
9631 /* On displays with a mutable colormap, figure out the colors
9632 allocated for the image by looking at the pixels of an XImage for
9634 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9635 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9641 /* Try to get an XImage for img->pixmep. */
9642 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9643 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9648 /* Initialize the color table. */
9649 init_color_table ();
9651 /* For each pixel of the image, look its color up in the
9652 color table. After having done so, the color table will
9653 contain an entry for each color used by the image. */
9654 for (y
= 0; y
< img
->height
; ++y
)
9655 for (x
= 0; x
< img
->width
; ++x
)
9657 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9658 lookup_pixel_color (f
, pixel
);
9661 /* Record colors in the image. Free color table and XImage. */
9662 img
->colors
= colors_in_color_table (&img
->ncolors
);
9663 free_color_table ();
9664 XDestroyImage (ximg
);
9666 #if 0 /* This doesn't seem to be the case. If we free the colors
9667 here, we get a BadAccess later in x_clear_image when
9668 freeing the colors. */
9669 /* We have allocated colors once, but Ghostscript has also
9670 allocated colors on behalf of us. So, to get the
9671 reference counts right, free them once. */
9674 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9675 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9676 img
->colors
, img
->ncolors
, 0);
9681 image_error ("Cannot get X image of `%s'; colors will not be freed",
9690 /***********************************************************************
9692 ***********************************************************************/
9694 DEFUN ("x-change-window-property", Fx_change_window_property
,
9695 Sx_change_window_property
, 2, 3, 0,
9696 "Change window property PROP to VALUE on the X window of FRAME.\n\
9697 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9698 selected frame. Value is VALUE.")
9699 (prop
, value
, frame
)
9700 Lisp_Object frame
, prop
, value
;
9702 struct frame
*f
= check_x_frame (frame
);
9705 CHECK_STRING (prop
, 1);
9706 CHECK_STRING (value
, 2);
9709 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9710 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9711 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9712 XSTRING (value
)->data
, XSTRING (value
)->size
);
9714 /* Make sure the property is set when we return. */
9715 XFlush (FRAME_X_DISPLAY (f
));
9722 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9723 Sx_delete_window_property
, 1, 2, 0,
9724 "Remove window property PROP from X window of FRAME.\n\
9725 FRAME nil or omitted means use the selected frame. Value is PROP.")
9727 Lisp_Object prop
, frame
;
9729 struct frame
*f
= check_x_frame (frame
);
9732 CHECK_STRING (prop
, 1);
9734 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9735 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9737 /* Make sure the property is removed when we return. */
9738 XFlush (FRAME_X_DISPLAY (f
));
9745 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9747 "Value is the value of window property PROP on FRAME.\n\
9748 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9749 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9752 Lisp_Object prop
, frame
;
9754 struct frame
*f
= check_x_frame (frame
);
9757 Lisp_Object prop_value
= Qnil
;
9758 char *tmp_data
= NULL
;
9761 unsigned long actual_size
, bytes_remaining
;
9763 CHECK_STRING (prop
, 1);
9765 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9766 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9767 prop_atom
, 0, 0, False
, XA_STRING
,
9768 &actual_type
, &actual_format
, &actual_size
,
9769 &bytes_remaining
, (unsigned char **) &tmp_data
);
9772 int size
= bytes_remaining
;
9777 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9778 prop_atom
, 0, bytes_remaining
,
9780 &actual_type
, &actual_format
,
9781 &actual_size
, &bytes_remaining
,
9782 (unsigned char **) &tmp_data
);
9784 prop_value
= make_string (tmp_data
, size
);
9795 /***********************************************************************
9797 ***********************************************************************/
9799 /* The implementation partly follows a patch from
9800 F.Pierresteguy@frcl.bull.fr dated 1994. */
9802 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9803 the next X event is read and we enter XTread_socket again. Setting
9804 it to 1 inhibits busy-cursor display for direct commands. */
9806 int inhibit_busy_cursor
;
9808 /* Incremented with each call to x-display-busy-cursor.
9809 Decremented in x-undisplay-busy-cursor. */
9811 static int busy_count
;
9814 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9815 Sx_show_busy_cursor
, 0, 0, 0,
9816 "Show a busy cursor, if not already shown.\n\
9817 Each call to this function must be matched by a call to\n\
9818 `x-hide-busy-cursor' to make the busy pointer disappear again.")
9822 if (busy_count
== 1)
9824 Lisp_Object rest
, frame
;
9826 FOR_EACH_FRAME (rest
, frame
)
9827 if (FRAME_X_P (XFRAME (frame
)))
9829 struct frame
*f
= XFRAME (frame
);
9832 f
->output_data
.x
->busy_p
= 1;
9834 if (!f
->output_data
.x
->busy_window
)
9836 unsigned long mask
= CWCursor
;
9837 XSetWindowAttributes attrs
;
9839 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9841 f
->output_data
.x
->busy_window
9842 = XCreateWindow (FRAME_X_DISPLAY (f
),
9843 FRAME_OUTER_WINDOW (f
),
9844 0, 0, 32000, 32000, 0, 0,
9850 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9859 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9860 Sx_hide_busy_cursor
, 0, 1, 0,
9861 "Hide a busy-cursor.\n\
9862 A busy-cursor will actually be undisplayed when a matching\n\
9863 `x-hide-busy-cursor' is called for each `x-show-busy-cursor'\n\
9864 issued. FORCE non-nil means hide the busy-cursor forcibly,\n\
9865 not counting calls.")
9869 Lisp_Object rest
, frame
;
9871 if (busy_count
== 0)
9874 if (!NILP (force
) && busy_count
!= 0)
9878 if (busy_count
!= 0)
9881 FOR_EACH_FRAME (rest
, frame
)
9883 struct frame
*f
= XFRAME (frame
);
9886 /* Watch out for newly created frames. */
9887 && f
->output_data
.x
->busy_window
)
9891 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9892 /* Sync here because XTread_socket looks at the busy_p flag
9893 that is reset to zero below. */
9894 XSync (FRAME_X_DISPLAY (f
), False
);
9896 f
->output_data
.x
->busy_p
= 0;
9905 /***********************************************************************
9907 ***********************************************************************/
9909 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9912 /* The frame of a currently visible tooltip, or null. */
9914 struct frame
*tip_frame
;
9916 /* If non-nil, a timer started that hides the last tooltip when it
9919 Lisp_Object tip_timer
;
9922 /* Create a frame for a tooltip on the display described by DPYINFO.
9923 PARMS is a list of frame parameters. Value is the frame. */
9926 x_create_tip_frame (dpyinfo
, parms
)
9927 struct x_display_info
*dpyinfo
;
9931 Lisp_Object frame
, tem
;
9933 long window_prompting
= 0;
9935 int count
= specpdl_ptr
- specpdl
;
9936 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9941 /* Use this general default value to start with until we know if
9942 this frame has a specified name. */
9943 Vx_resource_name
= Vinvocation_name
;
9946 kb
= dpyinfo
->kboard
;
9948 kb
= &the_only_kboard
;
9951 /* Get the name of the frame to use for resource lookup. */
9952 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9954 && !EQ (name
, Qunbound
)
9956 error ("Invalid frame name--not a string or nil");
9957 Vx_resource_name
= name
;
9960 GCPRO3 (parms
, name
, frame
);
9961 tip_frame
= f
= make_frame (1);
9962 XSETFRAME (frame
, f
);
9963 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9965 f
->output_method
= output_x_window
;
9966 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9967 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9968 f
->output_data
.x
->icon_bitmap
= -1;
9969 f
->output_data
.x
->fontset
= -1;
9970 f
->icon_name
= Qnil
;
9971 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9973 FRAME_KBOARD (f
) = kb
;
9975 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9976 f
->output_data
.x
->explicit_parent
= 0;
9978 /* Set the name; the functions to which we pass f expect the name to
9980 if (EQ (name
, Qunbound
) || NILP (name
))
9982 f
->name
= build_string (dpyinfo
->x_id_name
);
9983 f
->explicit_name
= 0;
9988 f
->explicit_name
= 1;
9989 /* use the frame's title when getting resources for this frame. */
9990 specbind (Qx_resource_name
, name
);
9993 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9994 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9995 fs_register_fontset (f
, XCAR (tem
));
9997 /* Extract the window parameters from the supplied values
9998 that are needed to determine window geometry. */
10002 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
10005 /* First, try whatever font the caller has specified. */
10006 if (STRINGP (font
))
10008 tem
= Fquery_fontset (font
, Qnil
);
10010 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10012 font
= x_new_font (f
, XSTRING (font
)->data
);
10015 /* Try out a font which we hope has bold and italic variations. */
10016 if (!STRINGP (font
))
10017 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10018 if (!STRINGP (font
))
10019 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10020 if (! STRINGP (font
))
10021 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10022 if (! STRINGP (font
))
10023 /* This was formerly the first thing tried, but it finds too many fonts
10024 and takes too long. */
10025 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10026 /* If those didn't work, look for something which will at least work. */
10027 if (! STRINGP (font
))
10028 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10030 if (! STRINGP (font
))
10031 font
= build_string ("fixed");
10033 x_default_parameter (f
, parms
, Qfont
, font
,
10034 "font", "Font", RES_TYPE_STRING
);
10037 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10038 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10040 /* This defaults to 2 in order to match xterm. We recognize either
10041 internalBorderWidth or internalBorder (which is what xterm calls
10043 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10047 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10048 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10049 if (! EQ (value
, Qunbound
))
10050 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10054 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10055 "internalBorderWidth", "internalBorderWidth",
10058 /* Also do the stuff which must be set before the window exists. */
10059 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10060 "foreground", "Foreground", RES_TYPE_STRING
);
10061 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10062 "background", "Background", RES_TYPE_STRING
);
10063 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10064 "pointerColor", "Foreground", RES_TYPE_STRING
);
10065 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10066 "cursorColor", "Foreground", RES_TYPE_STRING
);
10067 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10068 "borderColor", "BorderColor", RES_TYPE_STRING
);
10070 /* Init faces before x_default_parameter is called for scroll-bar
10071 parameters because that function calls x_set_scroll_bar_width,
10072 which calls change_frame_size, which calls Fset_window_buffer,
10073 which runs hooks, which call Fvertical_motion. At the end, we
10074 end up in init_iterator with a null face cache, which should not
10076 init_frame_faces (f
);
10078 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10079 window_prompting
= x_figure_window_size (f
, parms
);
10081 if (window_prompting
& XNegative
)
10083 if (window_prompting
& YNegative
)
10084 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10086 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10090 if (window_prompting
& YNegative
)
10091 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10093 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10096 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10098 XSetWindowAttributes attrs
;
10099 unsigned long mask
;
10102 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10103 /* Window managers looks at the override-redirect flag to
10104 determine whether or net to give windows a decoration (Xlib
10106 attrs
.override_redirect
= True
;
10107 attrs
.save_under
= True
;
10108 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10109 /* Arrange for getting MapNotify and UnmapNotify events. */
10110 attrs
.event_mask
= StructureNotifyMask
;
10112 = FRAME_X_WINDOW (f
)
10113 = XCreateWindow (FRAME_X_DISPLAY (f
),
10114 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10115 /* x, y, width, height */
10119 CopyFromParent
, InputOutput
, CopyFromParent
,
10126 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10127 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10128 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10129 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10130 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10131 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10133 /* Dimensions, especially f->height, must be done via change_frame_size.
10134 Change will not be effected unless different from the current
10137 height
= f
->height
;
10139 SET_FRAME_WIDTH (f
, 0);
10140 change_frame_size (f
, height
, width
, 1, 0, 0);
10146 /* It is now ok to make the frame official even if we get an error
10147 below. And the frame needs to be on Vframe_list or making it
10148 visible won't work. */
10149 Vframe_list
= Fcons (frame
, Vframe_list
);
10151 /* Now that the frame is official, it counts as a reference to
10153 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10155 return unbind_to (count
, frame
);
10159 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
10160 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10161 A tooltip window is a small X window displaying STRING at\n\
10162 the current mouse position.\n\
10163 FRAME nil or omitted means use the selected frame.\n\
10164 PARMS is an optional list of frame parameters which can be\n\
10165 used to change the tooltip's appearance.\n\
10166 Automatically hide the tooltip after TIMEOUT seconds.\n\
10167 TIMEOUT nil means use the default timeout of 5 seconds.")
10168 (string
, frame
, parms
, timeout
)
10169 Lisp_Object string
, frame
, parms
, timeout
;
10173 Window root
, child
;
10174 Lisp_Object buffer
;
10175 struct buffer
*old_buffer
;
10176 struct text_pos pos
;
10177 int i
, width
, height
;
10178 int root_x
, root_y
, win_x
, win_y
;
10180 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10181 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10182 int count
= specpdl_ptr
- specpdl
;
10184 specbind (Qinhibit_redisplay
, Qt
);
10186 GCPRO4 (string
, parms
, frame
, timeout
);
10188 CHECK_STRING (string
, 0);
10189 f
= check_x_frame (frame
);
10190 if (NILP (timeout
))
10191 timeout
= make_number (5);
10193 CHECK_NATNUM (timeout
, 2);
10195 /* Hide a previous tip, if any. */
10198 /* Add default values to frame parameters. */
10199 if (NILP (Fassq (Qname
, parms
)))
10200 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10201 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10202 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10203 if (NILP (Fassq (Qborder_width
, parms
)))
10204 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10205 if (NILP (Fassq (Qborder_color
, parms
)))
10206 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10207 if (NILP (Fassq (Qbackground_color
, parms
)))
10208 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10211 /* Create a frame for the tooltip, and record it in the global
10212 variable tip_frame. */
10213 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10214 tip_frame
= f
= XFRAME (frame
);
10216 /* Set up the frame's root window. Currently we use a size of 80
10217 columns x 40 lines. If someone wants to show a larger tip, he
10218 will loose. I don't think this is a realistic case. */
10219 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10220 w
->left
= w
->top
= make_number (0);
10224 w
->pseudo_window_p
= 1;
10226 /* Display the tooltip text in a temporary buffer. */
10227 buffer
= Fget_buffer_create (build_string (" *tip*"));
10228 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10229 old_buffer
= current_buffer
;
10230 set_buffer_internal_1 (XBUFFER (buffer
));
10232 Finsert (make_number (1), &string
);
10233 clear_glyph_matrix (w
->desired_matrix
);
10234 clear_glyph_matrix (w
->current_matrix
);
10235 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10236 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10238 /* Compute width and height of the tooltip. */
10239 width
= height
= 0;
10240 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10242 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10243 struct glyph
*last
;
10246 /* Stop at the first empty row at the end. */
10247 if (!row
->enabled_p
|| !row
->displays_text_p
)
10250 /* Let the row go over the full width of the frame. */
10251 row
->full_width_p
= 1;
10253 /* There's a glyph at the end of rows that is use to place
10254 the cursor there. Don't include the width of this glyph. */
10255 if (row
->used
[TEXT_AREA
])
10257 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10258 row_width
= row
->pixel_width
- last
->pixel_width
;
10261 row_width
= row
->pixel_width
;
10263 height
+= row
->height
;
10264 width
= max (width
, row_width
);
10267 /* Add the frame's internal border to the width and height the X
10268 window should have. */
10269 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10270 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10272 /* Move the tooltip window where the mouse pointer is. Resize and
10275 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10276 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10277 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10278 root_x
+ 5, root_y
- height
- 5, width
, height
);
10279 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10282 /* Draw into the window. */
10283 w
->must_be_updated_p
= 1;
10284 update_single_window (w
, 1);
10286 /* Restore original current buffer. */
10287 set_buffer_internal_1 (old_buffer
);
10288 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10290 /* Let the tip disappear after timeout seconds. */
10291 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10292 intern ("x-hide-tip"));
10295 return unbind_to (count
, Qnil
);
10299 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10300 "Hide the current tooltip window, if there is any.\n\
10301 Value is t is tooltip was open, nil otherwise.")
10304 int count
= specpdl_ptr
- specpdl
;
10307 specbind (Qinhibit_redisplay
, Qt
);
10309 if (!NILP (tip_timer
))
10311 call1 (intern ("cancel-timer"), tip_timer
);
10319 XSETFRAME (frame
, tip_frame
);
10320 Fdelete_frame (frame
, Qt
);
10325 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10330 /***********************************************************************
10331 File selection dialog
10332 ***********************************************************************/
10336 /* Callback for "OK" and "Cancel" on file selection dialog. */
10339 file_dialog_cb (widget
, client_data
, call_data
)
10341 XtPointer call_data
, client_data
;
10343 int *result
= (int *) client_data
;
10344 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10345 *result
= cb
->reason
;
10349 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10350 "Read file name, prompting with PROMPT in directory DIR.\n\
10351 Use a file selection dialog.\n\
10352 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10353 specified. Don't let the user enter a file name in the file\n\
10354 selection dialog's entry field, if MUSTMATCH is non-nil.")
10355 (prompt
, dir
, default_filename
, mustmatch
)
10356 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10359 struct frame
*f
= SELECTED_FRAME ();
10360 Lisp_Object file
= Qnil
;
10361 Widget dialog
, text
, list
, help
;
10364 extern XtAppContext Xt_app_con
;
10366 XmString dir_xmstring
, pattern_xmstring
;
10367 int popup_activated_flag
;
10368 int count
= specpdl_ptr
- specpdl
;
10369 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10371 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10372 CHECK_STRING (prompt
, 0);
10373 CHECK_STRING (dir
, 1);
10375 /* Prevent redisplay. */
10376 specbind (Qinhibit_redisplay
, Qt
);
10380 /* Create the dialog with PROMPT as title, using DIR as initial
10381 directory and using "*" as pattern. */
10382 dir
= Fexpand_file_name (dir
, Qnil
);
10383 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10384 pattern_xmstring
= XmStringCreateLocalized ("*");
10386 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10387 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10388 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10389 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10390 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10391 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10393 XmStringFree (dir_xmstring
);
10394 XmStringFree (pattern_xmstring
);
10396 /* Add callbacks for OK and Cancel. */
10397 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10398 (XtPointer
) &result
);
10399 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10400 (XtPointer
) &result
);
10402 /* Disable the help button since we can't display help. */
10403 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10404 XtSetSensitive (help
, False
);
10406 /* Mark OK button as default. */
10407 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10408 XmNshowAsDefault
, True
, NULL
);
10410 /* If MUSTMATCH is non-nil, disable the file entry field of the
10411 dialog, so that the user must select a file from the files list
10412 box. We can't remove it because we wouldn't have a way to get at
10413 the result file name, then. */
10414 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10415 if (!NILP (mustmatch
))
10418 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10419 XtSetSensitive (text
, False
);
10420 XtSetSensitive (label
, False
);
10423 /* Manage the dialog, so that list boxes get filled. */
10424 XtManageChild (dialog
);
10426 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10427 must include the path for this to work. */
10428 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10429 if (STRINGP (default_filename
))
10431 XmString default_xmstring
;
10435 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10437 if (!XmListItemExists (list
, default_xmstring
))
10439 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10440 XmListAddItem (list
, default_xmstring
, 0);
10444 item_pos
= XmListItemPos (list
, default_xmstring
);
10445 XmStringFree (default_xmstring
);
10447 /* Select the item and scroll it into view. */
10448 XmListSelectPos (list
, item_pos
, True
);
10449 XmListSetPos (list
, item_pos
);
10452 /* Process all events until the user presses Cancel or OK. */
10453 for (result
= 0; result
== 0;)
10456 Widget widget
, parent
;
10458 XtAppNextEvent (Xt_app_con
, &event
);
10460 /* See if the receiver of the event is one of the widgets of
10461 the file selection dialog. If so, dispatch it. If not,
10463 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10465 while (parent
&& parent
!= dialog
)
10466 parent
= XtParent (parent
);
10468 if (parent
== dialog
10469 || (event
.type
== Expose
10470 && !process_expose_from_menu (event
)))
10471 XtDispatchEvent (&event
);
10474 /* Get the result. */
10475 if (result
== XmCR_OK
)
10480 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10481 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10482 XmStringFree (text
);
10483 file
= build_string (data
);
10490 XtUnmanageChild (dialog
);
10491 XtDestroyWidget (dialog
);
10495 /* Make "Cancel" equivalent to C-g. */
10497 Fsignal (Qquit
, Qnil
);
10499 return unbind_to (count
, file
);
10502 #endif /* USE_MOTIF */
10505 /***********************************************************************
10507 ***********************************************************************/
10511 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10512 "Value is non-nil if SPEC is a valid image specification.")
10516 return valid_image_p (spec
) ? Qt
: Qnil
;
10520 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10526 if (valid_image_p (spec
))
10527 id
= lookup_image (SELECTED_FRAME (), spec
);
10529 debug_print (spec
);
10530 return make_number (id
);
10533 #endif /* GLYPH_DEBUG != 0 */
10537 /***********************************************************************
10539 ***********************************************************************/
10544 /* This is zero if not using X windows. */
10547 /* The section below is built by the lisp expression at the top of the file,
10548 just above where these variables are declared. */
10549 /*&&& init symbols here &&&*/
10550 Qauto_raise
= intern ("auto-raise");
10551 staticpro (&Qauto_raise
);
10552 Qauto_lower
= intern ("auto-lower");
10553 staticpro (&Qauto_lower
);
10554 Qbar
= intern ("bar");
10556 Qborder_color
= intern ("border-color");
10557 staticpro (&Qborder_color
);
10558 Qborder_width
= intern ("border-width");
10559 staticpro (&Qborder_width
);
10560 Qbox
= intern ("box");
10562 Qcursor_color
= intern ("cursor-color");
10563 staticpro (&Qcursor_color
);
10564 Qcursor_type
= intern ("cursor-type");
10565 staticpro (&Qcursor_type
);
10566 Qgeometry
= intern ("geometry");
10567 staticpro (&Qgeometry
);
10568 Qicon_left
= intern ("icon-left");
10569 staticpro (&Qicon_left
);
10570 Qicon_top
= intern ("icon-top");
10571 staticpro (&Qicon_top
);
10572 Qicon_type
= intern ("icon-type");
10573 staticpro (&Qicon_type
);
10574 Qicon_name
= intern ("icon-name");
10575 staticpro (&Qicon_name
);
10576 Qinternal_border_width
= intern ("internal-border-width");
10577 staticpro (&Qinternal_border_width
);
10578 Qleft
= intern ("left");
10579 staticpro (&Qleft
);
10580 Qright
= intern ("right");
10581 staticpro (&Qright
);
10582 Qmouse_color
= intern ("mouse-color");
10583 staticpro (&Qmouse_color
);
10584 Qnone
= intern ("none");
10585 staticpro (&Qnone
);
10586 Qparent_id
= intern ("parent-id");
10587 staticpro (&Qparent_id
);
10588 Qscroll_bar_width
= intern ("scroll-bar-width");
10589 staticpro (&Qscroll_bar_width
);
10590 Qsuppress_icon
= intern ("suppress-icon");
10591 staticpro (&Qsuppress_icon
);
10592 Qundefined_color
= intern ("undefined-color");
10593 staticpro (&Qundefined_color
);
10594 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10595 staticpro (&Qvertical_scroll_bars
);
10596 Qvisibility
= intern ("visibility");
10597 staticpro (&Qvisibility
);
10598 Qwindow_id
= intern ("window-id");
10599 staticpro (&Qwindow_id
);
10600 Qouter_window_id
= intern ("outer-window-id");
10601 staticpro (&Qouter_window_id
);
10602 Qx_frame_parameter
= intern ("x-frame-parameter");
10603 staticpro (&Qx_frame_parameter
);
10604 Qx_resource_name
= intern ("x-resource-name");
10605 staticpro (&Qx_resource_name
);
10606 Quser_position
= intern ("user-position");
10607 staticpro (&Quser_position
);
10608 Quser_size
= intern ("user-size");
10609 staticpro (&Quser_size
);
10610 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10611 staticpro (&Qscroll_bar_foreground
);
10612 Qscroll_bar_background
= intern ("scroll-bar-background");
10613 staticpro (&Qscroll_bar_background
);
10614 Qscreen_gamma
= intern ("screen-gamma");
10615 staticpro (&Qscreen_gamma
);
10616 /* This is the end of symbol initialization. */
10618 /* Text property `display' should be nonsticky by default. */
10619 Vtext_property_default_nonsticky
10620 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10623 Qlaplace
= intern ("laplace");
10624 staticpro (&Qlaplace
);
10626 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10627 staticpro (&Qface_set_after_frame_default
);
10629 Fput (Qundefined_color
, Qerror_conditions
,
10630 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10631 Fput (Qundefined_color
, Qerror_message
,
10632 build_string ("Undefined color"));
10634 init_x_parm_symbols ();
10636 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10637 "List of directories to search for bitmap files for X.");
10638 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10640 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10641 "The shape of the pointer when over text.\n\
10642 Changing the value does not affect existing frames\n\
10643 unless you set the mouse color.");
10644 Vx_pointer_shape
= Qnil
;
10646 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10647 "The name Emacs uses to look up X resources.\n\
10648 `x-get-resource' uses this as the first component of the instance name\n\
10649 when requesting resource values.\n\
10650 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10651 was invoked, or to the value specified with the `-name' or `-rn'\n\
10652 switches, if present.\n\
10654 It may be useful to bind this variable locally around a call\n\
10655 to `x-get-resource'. See also the variable `x-resource-class'.");
10656 Vx_resource_name
= Qnil
;
10658 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10659 "The class Emacs uses to look up X resources.\n\
10660 `x-get-resource' uses this as the first component of the instance class\n\
10661 when requesting resource values.\n\
10662 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10664 Setting this variable permanently is not a reasonable thing to do,\n\
10665 but binding this variable locally around a call to `x-get-resource'\n\
10666 is a reasonable practice. See also the variable `x-resource-name'.");
10667 Vx_resource_class
= build_string (EMACS_CLASS
);
10669 #if 0 /* This doesn't really do anything. */
10670 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10671 "The shape of the pointer when not over text.\n\
10672 This variable takes effect when you create a new frame\n\
10673 or when you set the mouse color.");
10675 Vx_nontext_pointer_shape
= Qnil
;
10677 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10678 "The shape of the pointer when Emacs is busy.\n\
10679 This variable takes effect when you create a new frame\n\
10680 or when you set the mouse color.");
10681 Vx_busy_pointer_shape
= Qnil
;
10683 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10684 "Non-zero means Emacs displays a busy cursor on window systems.");
10685 display_busy_cursor_p
= 1;
10687 #if 0 /* This doesn't really do anything. */
10688 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10689 "The shape of the pointer when over the mode line.\n\
10690 This variable takes effect when you create a new frame\n\
10691 or when you set the mouse color.");
10693 Vx_mode_pointer_shape
= Qnil
;
10695 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10696 &Vx_sensitive_text_pointer_shape
,
10697 "The shape of the pointer when over mouse-sensitive text.\n\
10698 This variable takes effect when you create a new frame\n\
10699 or when you set the mouse color.");
10700 Vx_sensitive_text_pointer_shape
= Qnil
;
10702 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10703 "A string indicating the foreground color of the cursor box.");
10704 Vx_cursor_fore_pixel
= Qnil
;
10706 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10707 "Non-nil if no X window manager is in use.\n\
10708 Emacs doesn't try to figure this out; this is always nil\n\
10709 unless you set it to something else.");
10710 /* We don't have any way to find this out, so set it to nil
10711 and maybe the user would like to set it to t. */
10712 Vx_no_window_manager
= Qnil
;
10714 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10715 &Vx_pixel_size_width_font_regexp
,
10716 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10718 Since Emacs gets width of a font matching with this regexp from\n\
10719 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10720 such a font. This is especially effective for such large fonts as\n\
10721 Chinese, Japanese, and Korean.");
10722 Vx_pixel_size_width_font_regexp
= Qnil
;
10724 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10725 "Time after which cached images are removed from the cache.\n\
10726 When an image has not been displayed this many seconds, remove it\n\
10727 from the image cache. Value must be an integer or nil with nil\n\
10728 meaning don't clear the cache.");
10729 Vimage_cache_eviction_delay
= make_number (30 * 60);
10731 DEFVAR_LISP ("image-types", &Vimage_types
,
10732 "List of supported image types.\n\
10733 Each element of the list is a symbol for a supported image type.");
10734 Vimage_types
= Qnil
;
10736 #ifdef USE_X_TOOLKIT
10737 Fprovide (intern ("x-toolkit"));
10740 Fprovide (intern ("motif"));
10743 defsubr (&Sx_get_resource
);
10745 /* X window properties. */
10746 defsubr (&Sx_change_window_property
);
10747 defsubr (&Sx_delete_window_property
);
10748 defsubr (&Sx_window_property
);
10751 defsubr (&Sx_draw_rectangle
);
10752 defsubr (&Sx_erase_rectangle
);
10753 defsubr (&Sx_contour_region
);
10754 defsubr (&Sx_uncontour_region
);
10756 defsubr (&Sxw_display_color_p
);
10757 defsubr (&Sx_display_grayscale_p
);
10758 defsubr (&Sxw_color_defined_p
);
10759 defsubr (&Sxw_color_values
);
10760 defsubr (&Sx_server_max_request_size
);
10761 defsubr (&Sx_server_vendor
);
10762 defsubr (&Sx_server_version
);
10763 defsubr (&Sx_display_pixel_width
);
10764 defsubr (&Sx_display_pixel_height
);
10765 defsubr (&Sx_display_mm_width
);
10766 defsubr (&Sx_display_mm_height
);
10767 defsubr (&Sx_display_screens
);
10768 defsubr (&Sx_display_planes
);
10769 defsubr (&Sx_display_color_cells
);
10770 defsubr (&Sx_display_visual_class
);
10771 defsubr (&Sx_display_backing_store
);
10772 defsubr (&Sx_display_save_under
);
10774 defsubr (&Sx_rebind_key
);
10775 defsubr (&Sx_rebind_keys
);
10776 defsubr (&Sx_track_pointer
);
10777 defsubr (&Sx_grab_pointer
);
10778 defsubr (&Sx_ungrab_pointer
);
10780 defsubr (&Sx_parse_geometry
);
10781 defsubr (&Sx_create_frame
);
10783 defsubr (&Sx_horizontal_line
);
10785 defsubr (&Sx_open_connection
);
10786 defsubr (&Sx_close_connection
);
10787 defsubr (&Sx_display_list
);
10788 defsubr (&Sx_synchronize
);
10790 /* Setting callback functions for fontset handler. */
10791 get_font_info_func
= x_get_font_info
;
10793 #if 0 /* This function pointer doesn't seem to be used anywhere.
10794 And the pointer assigned has the wrong type, anyway. */
10795 list_fonts_func
= x_list_fonts
;
10798 load_font_func
= x_load_font
;
10799 find_ccl_program_func
= x_find_ccl_program
;
10800 query_font_func
= x_query_font
;
10801 set_frame_fontset_func
= x_set_font
;
10802 check_window_system_func
= check_x
;
10805 Qxbm
= intern ("xbm");
10807 QCtype
= intern (":type");
10808 staticpro (&QCtype
);
10809 QCalgorithm
= intern (":algorithm");
10810 staticpro (&QCalgorithm
);
10811 QCheuristic_mask
= intern (":heuristic-mask");
10812 staticpro (&QCheuristic_mask
);
10813 QCcolor_symbols
= intern (":color-symbols");
10814 staticpro (&QCcolor_symbols
);
10815 QCdata
= intern (":data");
10816 staticpro (&QCdata
);
10817 QCascent
= intern (":ascent");
10818 staticpro (&QCascent
);
10819 QCmargin
= intern (":margin");
10820 staticpro (&QCmargin
);
10821 QCrelief
= intern (":relief");
10822 staticpro (&QCrelief
);
10823 Qpostscript
= intern ("postscript");
10824 staticpro (&Qpostscript
);
10825 QCloader
= intern (":loader");
10826 staticpro (&QCloader
);
10827 QCbounding_box
= intern (":bounding-box");
10828 staticpro (&QCbounding_box
);
10829 QCpt_width
= intern (":pt-width");
10830 staticpro (&QCpt_width
);
10831 QCpt_height
= intern (":pt-height");
10832 staticpro (&QCpt_height
);
10833 QCindex
= intern (":index");
10834 staticpro (&QCindex
);
10835 Qpbm
= intern ("pbm");
10839 Qxpm
= intern ("xpm");
10844 Qjpeg
= intern ("jpeg");
10845 staticpro (&Qjpeg
);
10849 Qtiff
= intern ("tiff");
10850 staticpro (&Qtiff
);
10854 Qgif
= intern ("gif");
10859 Qpng
= intern ("png");
10863 defsubr (&Sclear_image_cache
);
10866 defsubr (&Simagep
);
10867 defsubr (&Slookup_image
);
10871 defsubr (&Sx_show_busy_cursor
);
10872 defsubr (&Sx_hide_busy_cursor
);
10874 inhibit_busy_cursor
= 0;
10876 defsubr (&Sx_show_tip
);
10877 defsubr (&Sx_hide_tip
);
10878 staticpro (&tip_timer
);
10882 defsubr (&Sx_file_dialog
);
10890 image_types
= NULL
;
10891 Vimage_types
= Qnil
;
10893 define_image_type (&xbm_type
);
10894 define_image_type (&gs_type
);
10895 define_image_type (&pbm_type
);
10898 define_image_type (&xpm_type
);
10902 define_image_type (&jpeg_type
);
10906 define_image_type (&tiff_type
);
10910 define_image_type (&gif_type
);
10914 define_image_type (&png_type
);
10918 #endif /* HAVE_X_WINDOWS */