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 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
739 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
740 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
741 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
742 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
743 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
744 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
745 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
746 void x_set_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
747 void x_set_border_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
748 void x_set_internal_border_width
P_ ((struct frame
*, Lisp_Object
,
750 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
751 void x_set_autoraise
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
752 void x_set_autolower
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
753 void x_set_vertical_scroll_bars
P_ ((struct frame
*, Lisp_Object
,
755 void x_set_visibility
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
756 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
757 void x_set_scroll_bar_width
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
758 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
759 void x_set_unsplittable
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
760 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
761 void x_set_scroll_bar_foreground
P_ ((struct frame
*, Lisp_Object
,
763 void x_set_scroll_bar_background
P_ ((struct frame
*, Lisp_Object
,
765 static Lisp_Object x_default_scroll_bar_color_parameter
P_ ((struct frame
*,
770 static void x_set_screen_gamma
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
772 static struct x_frame_parm_table x_frame_parms
[] =
774 "auto-raise", x_set_autoraise
,
775 "auto-lower", x_set_autolower
,
776 "background-color", x_set_background_color
,
777 "border-color", x_set_border_color
,
778 "border-width", x_set_border_width
,
779 "cursor-color", x_set_cursor_color
,
780 "cursor-type", x_set_cursor_type
,
782 "foreground-color", x_set_foreground_color
,
783 "icon-name", x_set_icon_name
,
784 "icon-type", x_set_icon_type
,
785 "internal-border-width", x_set_internal_border_width
,
786 "menu-bar-lines", x_set_menu_bar_lines
,
787 "mouse-color", x_set_mouse_color
,
788 "name", x_explicitly_set_name
,
789 "scroll-bar-width", x_set_scroll_bar_width
,
790 "title", x_set_title
,
791 "unsplittable", x_set_unsplittable
,
792 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
793 "visibility", x_set_visibility
,
794 "tool-bar-lines", x_set_tool_bar_lines
,
795 "scroll-bar-foreground", x_set_scroll_bar_foreground
,
796 "scroll-bar-background", x_set_scroll_bar_background
,
797 "screen-gamma", x_set_screen_gamma
800 /* Attach the `x-frame-parameter' properties to
801 the Lisp symbol names of parameters relevant to X. */
804 init_x_parm_symbols ()
808 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
809 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
813 /* Change the parameters of frame F as specified by ALIST.
814 If a parameter is not specially recognized, do nothing;
815 otherwise call the `x_set_...' function for that parameter. */
818 x_set_frame_parameters (f
, alist
)
824 /* If both of these parameters are present, it's more efficient to
825 set them both at once. So we wait until we've looked at the
826 entire list before we set them. */
830 Lisp_Object left
, top
;
832 /* Same with these. */
833 Lisp_Object icon_left
, icon_top
;
835 /* Record in these vectors all the parms specified. */
839 int left_no_change
= 0, top_no_change
= 0;
840 int icon_left_no_change
= 0, icon_top_no_change
= 0;
842 struct gcpro gcpro1
, gcpro2
;
845 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
848 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
849 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
851 /* Extract parm names and values into those vectors. */
854 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
859 parms
[i
] = Fcar (elt
);
860 values
[i
] = Fcdr (elt
);
863 /* TAIL and ALIST are not used again below here. */
866 GCPRO2 (*parms
, *values
);
870 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
871 because their values appear in VALUES and strings are not valid. */
872 top
= left
= Qunbound
;
873 icon_left
= icon_top
= Qunbound
;
875 /* Provide default values for HEIGHT and WIDTH. */
876 if (FRAME_NEW_WIDTH (f
))
877 width
= FRAME_NEW_WIDTH (f
);
879 width
= FRAME_WIDTH (f
);
881 if (FRAME_NEW_HEIGHT (f
))
882 height
= FRAME_NEW_HEIGHT (f
);
884 height
= FRAME_HEIGHT (f
);
886 /* Process foreground_color and background_color before anything else.
887 They are independent of other properties, but other properties (e.g.,
888 cursor_color) are dependent upon them. */
889 for (p
= 0; p
< i
; p
++)
891 Lisp_Object prop
, val
;
895 if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
897 register Lisp_Object param_index
, old_value
;
899 param_index
= Fget (prop
, Qx_frame_parameter
);
900 old_value
= get_frame_param (f
, prop
);
901 store_frame_param (f
, prop
, val
);
902 if (NATNUMP (param_index
)
903 && (XFASTINT (param_index
)
904 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
905 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
909 /* Now process them in reverse of specified order. */
910 for (i
--; i
>= 0; i
--)
912 Lisp_Object prop
, val
;
917 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
918 width
= XFASTINT (val
);
919 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
920 height
= XFASTINT (val
);
921 else if (EQ (prop
, Qtop
))
923 else if (EQ (prop
, Qleft
))
925 else if (EQ (prop
, Qicon_top
))
927 else if (EQ (prop
, Qicon_left
))
929 else if (EQ (prop
, Qforeground_color
) || EQ (prop
, Qbackground_color
))
930 /* Processed above. */
934 register Lisp_Object param_index
, old_value
;
936 param_index
= Fget (prop
, Qx_frame_parameter
);
937 old_value
= get_frame_param (f
, prop
);
938 store_frame_param (f
, prop
, val
);
939 if (NATNUMP (param_index
)
940 && (XFASTINT (param_index
)
941 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
942 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
946 /* Don't die if just one of these was set. */
947 if (EQ (left
, Qunbound
))
950 if (f
->output_data
.x
->left_pos
< 0)
951 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->left_pos
), Qnil
));
953 XSETINT (left
, f
->output_data
.x
->left_pos
);
955 if (EQ (top
, Qunbound
))
958 if (f
->output_data
.x
->top_pos
< 0)
959 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.x
->top_pos
), Qnil
));
961 XSETINT (top
, f
->output_data
.x
->top_pos
);
964 /* If one of the icon positions was not set, preserve or default it. */
965 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
967 icon_left_no_change
= 1;
968 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
969 if (NILP (icon_left
))
970 XSETINT (icon_left
, 0);
972 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
974 icon_top_no_change
= 1;
975 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
977 XSETINT (icon_top
, 0);
980 /* Don't set these parameters unless they've been explicitly
981 specified. The window might be mapped or resized while we're in
982 this function, and we don't want to override that unless the lisp
983 code has asked for it.
985 Don't set these parameters unless they actually differ from the
986 window's current parameters; the window may not actually exist
991 check_frame_size (f
, &height
, &width
);
993 XSETFRAME (frame
, f
);
995 if (width
!= FRAME_WIDTH (f
)
996 || height
!= FRAME_HEIGHT (f
)
997 || FRAME_NEW_HEIGHT (f
) || FRAME_NEW_WIDTH (f
))
998 Fset_frame_size (frame
, make_number (width
), make_number (height
));
1000 if ((!NILP (left
) || !NILP (top
))
1001 && ! (left_no_change
&& top_no_change
)
1002 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.x
->left_pos
1003 && NUMBERP (top
) && XINT (top
) == f
->output_data
.x
->top_pos
))
1008 /* Record the signs. */
1009 f
->output_data
.x
->size_hint_flags
&= ~ (XNegative
| YNegative
);
1010 if (EQ (left
, Qminus
))
1011 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1012 else if (INTEGERP (left
))
1014 leftpos
= XINT (left
);
1016 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1018 else if (CONSP (left
) && EQ (XCAR (left
), Qminus
)
1019 && CONSP (XCDR (left
))
1020 && INTEGERP (XCAR (XCDR (left
))))
1022 leftpos
= - XINT (XCAR (XCDR (left
)));
1023 f
->output_data
.x
->size_hint_flags
|= XNegative
;
1025 else if (CONSP (left
) && EQ (XCAR (left
), Qplus
)
1026 && CONSP (XCDR (left
))
1027 && INTEGERP (XCAR (XCDR (left
))))
1029 leftpos
= XINT (XCAR (XCDR (left
)));
1032 if (EQ (top
, Qminus
))
1033 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1034 else if (INTEGERP (top
))
1036 toppos
= XINT (top
);
1038 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1040 else if (CONSP (top
) && EQ (XCAR (top
), Qminus
)
1041 && CONSP (XCDR (top
))
1042 && INTEGERP (XCAR (XCDR (top
))))
1044 toppos
= - XINT (XCAR (XCDR (top
)));
1045 f
->output_data
.x
->size_hint_flags
|= YNegative
;
1047 else if (CONSP (top
) && EQ (XCAR (top
), Qplus
)
1048 && CONSP (XCDR (top
))
1049 && INTEGERP (XCAR (XCDR (top
))))
1051 toppos
= XINT (XCAR (XCDR (top
)));
1055 /* Store the numeric value of the position. */
1056 f
->output_data
.x
->top_pos
= toppos
;
1057 f
->output_data
.x
->left_pos
= leftpos
;
1059 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
1061 /* Actually set that position, and convert to absolute. */
1062 x_set_offset (f
, leftpos
, toppos
, -1);
1065 if ((!NILP (icon_left
) || !NILP (icon_top
))
1066 && ! (icon_left_no_change
&& icon_top_no_change
))
1067 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
1073 /* Store the screen positions of frame F into XPTR and YPTR.
1074 These are the positions of the containing window manager window,
1075 not Emacs's own window. */
1078 x_real_positions (f
, xptr
, yptr
)
1085 /* This is pretty gross, but seems to be the easiest way out of
1086 the problem that arises when restarting window-managers. */
1088 #ifdef USE_X_TOOLKIT
1089 Window outer
= (f
->output_data
.x
->widget
1090 ? XtWindow (f
->output_data
.x
->widget
)
1091 : FRAME_X_WINDOW (f
));
1093 Window outer
= f
->output_data
.x
->window_desc
;
1095 Window tmp_root_window
;
1096 Window
*tmp_children
;
1101 int count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1102 Window outer_window
;
1104 XQueryTree (FRAME_X_DISPLAY (f
), outer
, &tmp_root_window
,
1105 &f
->output_data
.x
->parent_desc
,
1106 &tmp_children
, &tmp_nchildren
);
1107 XFree ((char *) tmp_children
);
1111 /* Find the position of the outside upper-left corner of
1112 the inner window, with respect to the outer window. */
1113 if (f
->output_data
.x
->parent_desc
!= FRAME_X_DISPLAY_INFO (f
)->root_window
)
1114 outer_window
= f
->output_data
.x
->parent_desc
;
1116 outer_window
= outer
;
1118 XTranslateCoordinates (FRAME_X_DISPLAY (f
),
1120 /* From-window, to-window. */
1122 FRAME_X_DISPLAY_INFO (f
)->root_window
,
1124 /* From-position, to-position. */
1125 0, 0, &win_x
, &win_y
,
1130 /* It is possible for the window returned by the XQueryNotify
1131 to become invalid by the time we call XTranslateCoordinates.
1132 That can happen when you restart some window managers.
1133 If so, we get an error in XTranslateCoordinates.
1134 Detect that and try the whole thing over. */
1135 if (! x_had_errors_p (FRAME_X_DISPLAY (f
)))
1137 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1141 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1148 /* Insert a description of internally-recorded parameters of frame X
1149 into the parameter alist *ALISTPTR that is to be given to the user.
1150 Only parameters that are specific to the X window system
1151 and whose values are not correctly recorded in the frame's
1152 param_alist need to be considered here. */
1155 x_report_frame_params (f
, alistptr
)
1157 Lisp_Object
*alistptr
;
1162 /* Represent negative positions (off the top or left screen edge)
1163 in a way that Fmodify_frame_parameters will understand correctly. */
1164 XSETINT (tem
, f
->output_data
.x
->left_pos
);
1165 if (f
->output_data
.x
->left_pos
>= 0)
1166 store_in_alist (alistptr
, Qleft
, tem
);
1168 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1170 XSETINT (tem
, f
->output_data
.x
->top_pos
);
1171 if (f
->output_data
.x
->top_pos
>= 0)
1172 store_in_alist (alistptr
, Qtop
, tem
);
1174 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
1176 store_in_alist (alistptr
, Qborder_width
,
1177 make_number (f
->output_data
.x
->border_width
));
1178 store_in_alist (alistptr
, Qinternal_border_width
,
1179 make_number (f
->output_data
.x
->internal_border_width
));
1180 sprintf (buf
, "%ld", (long) FRAME_X_WINDOW (f
));
1181 store_in_alist (alistptr
, Qwindow_id
,
1182 build_string (buf
));
1183 #ifdef USE_X_TOOLKIT
1184 /* Tooltip frame may not have this widget. */
1185 if (f
->output_data
.x
->widget
)
1187 sprintf (buf
, "%ld", (long) FRAME_OUTER_WINDOW (f
));
1188 store_in_alist (alistptr
, Qouter_window_id
,
1189 build_string (buf
));
1190 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
1191 FRAME_SAMPLE_VISIBILITY (f
);
1192 store_in_alist (alistptr
, Qvisibility
,
1193 (FRAME_VISIBLE_P (f
) ? Qt
1194 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
1195 store_in_alist (alistptr
, Qdisplay
,
1196 XCAR (FRAME_X_DISPLAY_INFO (f
)->name_list_element
));
1198 if (f
->output_data
.x
->parent_desc
== FRAME_X_DISPLAY_INFO (f
)->root_window
)
1201 XSETFASTINT (tem
, f
->output_data
.x
->parent_desc
);
1202 store_in_alist (alistptr
, Qparent_id
, tem
);
1207 /* Gamma-correct COLOR on frame F. */
1210 gamma_correct (f
, color
)
1216 color
->red
= pow (color
->red
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1217 color
->green
= pow (color
->green
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1218 color
->blue
= pow (color
->blue
/ 65535.0, f
->gamma
) * 65535.0 + 0.5;
1223 /* Decide if color named COLOR is valid for the display associated with
1224 the selected frame; if so, return the rgb values in COLOR_DEF.
1225 If ALLOC is nonzero, allocate a new colormap cell. */
1228 x_defined_color (f
, color
, color_def
, alloc
)
1234 register int status
;
1235 Colormap screen_colormap
;
1236 Display
*display
= FRAME_X_DISPLAY (f
);
1239 screen_colormap
= DefaultColormap (display
, XDefaultScreen (display
));
1241 status
= XParseColor (display
, screen_colormap
, color
, color_def
);
1242 if (status
&& alloc
)
1244 /* Apply gamma correction. */
1245 gamma_correct (f
, color_def
);
1247 status
= XAllocColor (display
, screen_colormap
, color_def
);
1250 /* If we got to this point, the colormap is full, so we're
1251 going to try and get the next closest color.
1252 The algorithm used is a least-squares matching, which is
1253 what X uses for closest color matching with StaticColor visuals. */
1258 long nearest_delta
, trial_delta
;
1261 no_cells
= XDisplayCells (display
, XDefaultScreen (display
));
1262 cells
= (XColor
*) alloca (sizeof (XColor
) * no_cells
);
1264 for (x
= 0; x
< no_cells
; x
++)
1267 XQueryColors (display
, screen_colormap
, cells
, no_cells
);
1269 /* I'm assuming CSE so I'm not going to condense this. */
1270 nearest_delta
= ((((color_def
->red
>> 8) - (cells
[0].red
>> 8))
1271 * ((color_def
->red
>> 8) - (cells
[0].red
>> 8)))
1273 (((color_def
->green
>> 8) - (cells
[0].green
>> 8))
1274 * ((color_def
->green
>> 8) - (cells
[0].green
>> 8)))
1276 (((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))
1277 * ((color_def
->blue
>> 8) - (cells
[0].blue
>> 8))));
1278 for (x
= 1; x
< no_cells
; x
++)
1280 trial_delta
= ((((color_def
->red
>> 8) - (cells
[x
].red
>> 8))
1281 * ((color_def
->red
>> 8) - (cells
[x
].red
>> 8)))
1283 (((color_def
->green
>> 8) - (cells
[x
].green
>> 8))
1284 * ((color_def
->green
>> 8) - (cells
[x
].green
>> 8)))
1286 (((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))
1287 * ((color_def
->blue
>> 8) - (cells
[x
].blue
>> 8))));
1288 if (trial_delta
< nearest_delta
)
1291 temp
.red
= cells
[x
].red
;
1292 temp
.green
= cells
[x
].green
;
1293 temp
.blue
= cells
[x
].blue
;
1294 status
= XAllocColor (display
, screen_colormap
, &temp
);
1298 nearest_delta
= trial_delta
;
1302 color_def
->red
= cells
[nearest
].red
;
1303 color_def
->green
= cells
[nearest
].green
;
1304 color_def
->blue
= cells
[nearest
].blue
;
1305 status
= XAllocColor (display
, screen_colormap
, color_def
);
1316 /* Given a string ARG naming a color, compute a pixel value from it
1317 suitable for screen F.
1318 If F is not a color screen, return DEF (default) regardless of what
1322 x_decode_color (f
, arg
, def
)
1329 CHECK_STRING (arg
, 0);
1331 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1332 return BLACK_PIX_DEFAULT (f
);
1333 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1334 return WHITE_PIX_DEFAULT (f
);
1336 if (FRAME_X_DISPLAY_INFO (f
)->n_planes
== 1)
1339 /* x_defined_color is responsible for coping with failures
1340 by looking for a near-miss. */
1341 if (x_defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1344 Fsignal (Qerror
, Fcons (build_string ("undefined color"),
1345 Fcons (arg
, Qnil
)));
1348 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1349 the previous value of that parameter, NEW_VALUE is the new value. */
1352 x_set_screen_gamma (f
, new_value
, old_value
)
1354 Lisp_Object new_value
, old_value
;
1356 if (NILP (new_value
))
1358 else if (NUMBERP (new_value
) && XFLOATINT (new_value
) > 0)
1359 /* The value 0.4545 is the normal viewing gamma. */
1360 f
->gamma
= 1.0 / (0.4545 * XFLOATINT (new_value
));
1362 Fsignal (Qerror
, Fcons (build_string ("Illegal screen-gamma"),
1363 Fcons (new_value
, Qnil
)));
1365 clear_face_cache (0);
1369 /* Functions called only from `x_set_frame_param'
1370 to set individual parameters.
1372 If FRAME_X_WINDOW (f) is 0,
1373 the frame is being created and its X-window does not exist yet.
1374 In that case, just record the parameter's new value
1375 in the standard place; do not attempt to change the window. */
1378 x_set_foreground_color (f
, arg
, oldval
)
1380 Lisp_Object arg
, oldval
;
1383 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1385 unload_color (f
, f
->output_data
.x
->foreground_pixel
);
1386 f
->output_data
.x
->foreground_pixel
= pixel
;
1388 if (FRAME_X_WINDOW (f
) != 0)
1391 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1392 f
->output_data
.x
->foreground_pixel
);
1393 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1394 f
->output_data
.x
->foreground_pixel
);
1396 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1397 if (FRAME_VISIBLE_P (f
))
1403 x_set_background_color (f
, arg
, oldval
)
1405 Lisp_Object arg
, oldval
;
1408 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1410 unload_color (f
, f
->output_data
.x
->background_pixel
);
1411 f
->output_data
.x
->background_pixel
= pixel
;
1413 if (FRAME_X_WINDOW (f
) != 0)
1416 /* The main frame area. */
1417 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->normal_gc
,
1418 f
->output_data
.x
->background_pixel
);
1419 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->reverse_gc
,
1420 f
->output_data
.x
->background_pixel
);
1421 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1422 f
->output_data
.x
->background_pixel
);
1423 XSetWindowBackground (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1424 f
->output_data
.x
->background_pixel
);
1427 for (bar
= FRAME_SCROLL_BARS (f
); !NILP (bar
);
1428 bar
= XSCROLL_BAR (bar
)->next
)
1429 XSetWindowBackground (FRAME_X_DISPLAY (f
),
1430 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar
)),
1431 f
->output_data
.x
->background_pixel
);
1435 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1437 if (FRAME_VISIBLE_P (f
))
1443 x_set_mouse_color (f
, arg
, oldval
)
1445 Lisp_Object arg
, oldval
;
1447 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1450 unsigned long pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1451 unsigned long mask_color
= f
->output_data
.x
->background_pixel
;
1453 /* Don't let pointers be invisible. */
1454 if (mask_color
== pixel
1455 && mask_color
== f
->output_data
.x
->background_pixel
)
1456 pixel
= f
->output_data
.x
->foreground_pixel
;
1458 unload_color (f
, f
->output_data
.x
->mouse_pixel
);
1459 f
->output_data
.x
->mouse_pixel
= pixel
;
1463 /* It's not okay to crash if the user selects a screwy cursor. */
1464 count
= x_catch_errors (FRAME_X_DISPLAY (f
));
1466 if (!EQ (Qnil
, Vx_pointer_shape
))
1468 CHECK_NUMBER (Vx_pointer_shape
, 0);
1469 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XINT (Vx_pointer_shape
));
1472 cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1473 x_check_errors (FRAME_X_DISPLAY (f
), "bad text pointer cursor: %s");
1475 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1477 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1478 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1479 XINT (Vx_nontext_pointer_shape
));
1482 nontext_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_left_ptr
);
1483 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1485 if (!EQ (Qnil
, Vx_busy_pointer_shape
))
1487 CHECK_NUMBER (Vx_busy_pointer_shape
, 0);
1488 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1489 XINT (Vx_busy_pointer_shape
));
1492 busy_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_watch
);
1493 x_check_errors (FRAME_X_DISPLAY (f
), "bad busy pointer cursor: %s");
1495 x_check_errors (FRAME_X_DISPLAY (f
), "bad nontext pointer cursor: %s");
1496 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1498 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1499 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
),
1500 XINT (Vx_mode_pointer_shape
));
1503 mode_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_xterm
);
1504 x_check_errors (FRAME_X_DISPLAY (f
), "bad modeline pointer cursor: %s");
1506 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1508 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1510 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1511 XINT (Vx_sensitive_text_pointer_shape
));
1514 cross_cursor
= XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_crosshair
);
1516 /* Check and report errors with the above calls. */
1517 x_check_errors (FRAME_X_DISPLAY (f
), "can't set cursor shape: %s");
1518 x_uncatch_errors (FRAME_X_DISPLAY (f
), count
);
1521 XColor fore_color
, back_color
;
1523 fore_color
.pixel
= f
->output_data
.x
->mouse_pixel
;
1524 back_color
.pixel
= mask_color
;
1525 XQueryColor (FRAME_X_DISPLAY (f
),
1526 DefaultColormap (FRAME_X_DISPLAY (f
),
1527 DefaultScreen (FRAME_X_DISPLAY (f
))),
1529 XQueryColor (FRAME_X_DISPLAY (f
),
1530 DefaultColormap (FRAME_X_DISPLAY (f
),
1531 DefaultScreen (FRAME_X_DISPLAY (f
))),
1533 XRecolorCursor (FRAME_X_DISPLAY (f
), cursor
,
1534 &fore_color
, &back_color
);
1535 XRecolorCursor (FRAME_X_DISPLAY (f
), nontext_cursor
,
1536 &fore_color
, &back_color
);
1537 XRecolorCursor (FRAME_X_DISPLAY (f
), mode_cursor
,
1538 &fore_color
, &back_color
);
1539 XRecolorCursor (FRAME_X_DISPLAY (f
), cross_cursor
,
1540 &fore_color
, &back_color
);
1541 XRecolorCursor (FRAME_X_DISPLAY (f
), busy_cursor
,
1542 &fore_color
, &back_color
);
1545 if (FRAME_X_WINDOW (f
) != 0)
1546 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), cursor
);
1548 if (cursor
!= f
->output_data
.x
->text_cursor
&& f
->output_data
.x
->text_cursor
!= 0)
1549 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->text_cursor
);
1550 f
->output_data
.x
->text_cursor
= cursor
;
1552 if (nontext_cursor
!= f
->output_data
.x
->nontext_cursor
1553 && f
->output_data
.x
->nontext_cursor
!= 0)
1554 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->nontext_cursor
);
1555 f
->output_data
.x
->nontext_cursor
= nontext_cursor
;
1557 if (busy_cursor
!= f
->output_data
.x
->busy_cursor
1558 && f
->output_data
.x
->busy_cursor
!= 0)
1559 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_cursor
);
1560 f
->output_data
.x
->busy_cursor
= busy_cursor
;
1562 if (mode_cursor
!= f
->output_data
.x
->modeline_cursor
1563 && f
->output_data
.x
->modeline_cursor
!= 0)
1564 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->modeline_cursor
);
1565 f
->output_data
.x
->modeline_cursor
= mode_cursor
;
1567 if (cross_cursor
!= f
->output_data
.x
->cross_cursor
1568 && f
->output_data
.x
->cross_cursor
!= 0)
1569 XFreeCursor (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cross_cursor
);
1570 f
->output_data
.x
->cross_cursor
= cross_cursor
;
1572 XFlush (FRAME_X_DISPLAY (f
));
1575 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1579 x_set_cursor_color (f
, arg
, oldval
)
1581 Lisp_Object arg
, oldval
;
1583 unsigned long fore_pixel
, pixel
;
1585 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1586 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1587 WHITE_PIX_DEFAULT (f
));
1589 fore_pixel
= f
->output_data
.x
->background_pixel
;
1590 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1592 /* Make sure that the cursor color differs from the background color. */
1593 if (pixel
== f
->output_data
.x
->background_pixel
)
1595 pixel
= f
->output_data
.x
->mouse_pixel
;
1596 if (pixel
== fore_pixel
)
1597 fore_pixel
= f
->output_data
.x
->background_pixel
;
1600 unload_color (f
, f
->output_data
.x
->cursor_foreground_pixel
);
1601 f
->output_data
.x
->cursor_foreground_pixel
= fore_pixel
;
1603 unload_color (f
, f
->output_data
.x
->cursor_pixel
);
1604 f
->output_data
.x
->cursor_pixel
= pixel
;
1606 if (FRAME_X_WINDOW (f
) != 0)
1609 XSetBackground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1610 f
->output_data
.x
->cursor_pixel
);
1611 XSetForeground (FRAME_X_DISPLAY (f
), f
->output_data
.x
->cursor_gc
,
1615 if (FRAME_VISIBLE_P (f
))
1617 x_update_cursor (f
, 0);
1618 x_update_cursor (f
, 1);
1622 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1625 /* Set the border-color of frame F to value described by ARG.
1626 ARG can be a string naming a color.
1627 The border-color is used for the border that is drawn by the X server.
1628 Note that this does not fully take effect if done before
1629 F has an x-window; it must be redone when the window is created.
1631 Note: this is done in two routines because of the way X10 works.
1633 Note: under X11, this is normally the province of the window manager,
1634 and so emacs' border colors may be overridden. */
1637 x_set_border_color (f
, arg
, oldval
)
1639 Lisp_Object arg
, oldval
;
1643 CHECK_STRING (arg
, 0);
1644 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1645 x_set_border_pixel (f
, pix
);
1646 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1649 /* Set the border-color of frame F to pixel value PIX.
1650 Note that this does not fully take effect if done before
1651 F has an x-window. */
1654 x_set_border_pixel (f
, pix
)
1658 unload_color (f
, f
->output_data
.x
->border_pixel
);
1659 f
->output_data
.x
->border_pixel
= pix
;
1661 if (FRAME_X_WINDOW (f
) != 0 && f
->output_data
.x
->border_width
> 0)
1664 XSetWindowBorder (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
1665 (unsigned long)pix
);
1668 if (FRAME_VISIBLE_P (f
))
1674 x_set_cursor_type (f
, arg
, oldval
)
1676 Lisp_Object arg
, oldval
;
1680 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1681 f
->output_data
.x
->cursor_width
= 2;
1683 else if (CONSP (arg
) && EQ (XCAR (arg
), Qbar
)
1684 && INTEGERP (XCDR (arg
)))
1686 FRAME_DESIRED_CURSOR (f
) = BAR_CURSOR
;
1687 f
->output_data
.x
->cursor_width
= XINT (XCDR (arg
));
1690 /* Treat anything unknown as "box cursor".
1691 It was bad to signal an error; people have trouble fixing
1692 .Xdefaults with Emacs, when it has something bad in it. */
1693 FRAME_DESIRED_CURSOR (f
) = FILLED_BOX_CURSOR
;
1695 /* Make sure the cursor gets redrawn. This is overkill, but how
1696 often do people change cursor types? */
1697 update_mode_lines
++;
1701 x_set_icon_type (f
, arg
, oldval
)
1703 Lisp_Object arg
, oldval
;
1709 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1712 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1717 result
= x_text_icon (f
,
1718 (char *) XSTRING ((!NILP (f
->icon_name
)
1722 result
= x_bitmap_icon (f
, arg
);
1727 error ("No icon window available");
1730 XFlush (FRAME_X_DISPLAY (f
));
1734 /* Return non-nil if frame F wants a bitmap icon. */
1742 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1750 x_set_icon_name (f
, arg
, oldval
)
1752 Lisp_Object arg
, oldval
;
1758 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1761 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1766 if (f
->output_data
.x
->icon_bitmap
!= 0)
1771 result
= x_text_icon (f
,
1772 (char *) XSTRING ((!NILP (f
->icon_name
)
1781 error ("No icon window available");
1784 XFlush (FRAME_X_DISPLAY (f
));
1789 x_set_font (f
, arg
, oldval
)
1791 Lisp_Object arg
, oldval
;
1794 Lisp_Object fontset_name
;
1797 CHECK_STRING (arg
, 1);
1799 fontset_name
= Fquery_fontset (arg
, Qnil
);
1802 result
= (STRINGP (fontset_name
)
1803 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
1804 : x_new_font (f
, XSTRING (arg
)->data
));
1807 if (EQ (result
, Qnil
))
1808 error ("Font `%s' is not defined", XSTRING (arg
)->data
);
1809 else if (EQ (result
, Qt
))
1810 error ("The characters of the given font have varying widths");
1811 else if (STRINGP (result
))
1813 store_frame_param (f
, Qfont
, result
);
1814 recompute_basic_faces (f
);
1819 do_pending_window_change (0);
1821 /* Don't call `face-set-after-frame-default' when faces haven't been
1822 initialized yet. This is the case when called from
1823 Fx_create_frame. In that case, the X widget or window doesn't
1824 exist either, and we can end up in x_report_frame_params with a
1825 null widget which gives a segfault. */
1826 if (FRAME_FACE_CACHE (f
))
1828 XSETFRAME (frame
, f
);
1829 call1 (Qface_set_after_frame_default
, frame
);
1834 x_set_border_width (f
, arg
, oldval
)
1836 Lisp_Object arg
, oldval
;
1838 CHECK_NUMBER (arg
, 0);
1840 if (XINT (arg
) == f
->output_data
.x
->border_width
)
1843 if (FRAME_X_WINDOW (f
) != 0)
1844 error ("Cannot change the border width of a window");
1846 f
->output_data
.x
->border_width
= XINT (arg
);
1850 x_set_internal_border_width (f
, arg
, oldval
)
1852 Lisp_Object arg
, oldval
;
1854 int old
= f
->output_data
.x
->internal_border_width
;
1856 CHECK_NUMBER (arg
, 0);
1857 f
->output_data
.x
->internal_border_width
= XINT (arg
);
1858 if (f
->output_data
.x
->internal_border_width
< 0)
1859 f
->output_data
.x
->internal_border_width
= 0;
1861 #ifdef USE_X_TOOLKIT
1862 if (f
->output_data
.x
->edit_widget
)
1863 widget_store_internal_border (f
->output_data
.x
->edit_widget
);
1866 if (f
->output_data
.x
->internal_border_width
== old
)
1869 if (FRAME_X_WINDOW (f
) != 0)
1871 x_set_window_size (f
, 0, f
->width
, f
->height
);
1872 SET_FRAME_GARBAGED (f
);
1873 do_pending_window_change (0);
1878 x_set_visibility (f
, value
, oldval
)
1880 Lisp_Object value
, oldval
;
1883 XSETFRAME (frame
, f
);
1886 Fmake_frame_invisible (frame
, Qt
);
1887 else if (EQ (value
, Qicon
))
1888 Ficonify_frame (frame
);
1890 Fmake_frame_visible (frame
);
1894 x_set_menu_bar_lines_1 (window
, n
)
1898 struct window
*w
= XWINDOW (window
);
1900 XSETFASTINT (w
->top
, XFASTINT (w
->top
) + n
);
1901 XSETFASTINT (w
->height
, XFASTINT (w
->height
) - n
);
1903 /* Handle just the top child in a vertical split. */
1904 if (!NILP (w
->vchild
))
1905 x_set_menu_bar_lines_1 (w
->vchild
, n
);
1907 /* Adjust all children in a horizontal split. */
1908 for (window
= w
->hchild
; !NILP (window
); window
= w
->next
)
1910 w
= XWINDOW (window
);
1911 x_set_menu_bar_lines_1 (window
, n
);
1916 x_set_menu_bar_lines (f
, value
, oldval
)
1918 Lisp_Object value
, oldval
;
1921 #ifndef USE_X_TOOLKIT
1922 int olines
= FRAME_MENU_BAR_LINES (f
);
1925 /* Right now, menu bars don't work properly in minibuf-only frames;
1926 most of the commands try to apply themselves to the minibuffer
1927 frame itself, and get an error because you can't switch buffers
1928 in or split the minibuffer window. */
1929 if (FRAME_MINIBUF_ONLY_P (f
))
1932 if (INTEGERP (value
))
1933 nlines
= XINT (value
);
1937 /* Make sure we redisplay all windows in this frame. */
1938 windows_or_buffers_changed
++;
1940 #ifdef USE_X_TOOLKIT
1941 FRAME_MENU_BAR_LINES (f
) = 0;
1944 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1945 if (FRAME_X_P (f
) && f
->output_data
.x
->menubar_widget
== 0)
1946 /* Make sure next redisplay shows the menu bar. */
1947 XWINDOW (FRAME_SELECTED_WINDOW (f
))->update_mode_line
= Qt
;
1951 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1952 free_frame_menubar (f
);
1953 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1955 f
->output_data
.x
->menubar_widget
= 0;
1957 #else /* not USE_X_TOOLKIT */
1958 FRAME_MENU_BAR_LINES (f
) = nlines
;
1959 x_set_menu_bar_lines_1 (f
->root_window
, nlines
- olines
);
1960 #endif /* not USE_X_TOOLKIT */
1965 /* Set the number of lines used for the tool bar of frame F to VALUE.
1966 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1967 is the old number of tool bar lines. This function changes the
1968 height of all windows on frame F to match the new tool bar height.
1969 The frame's height doesn't change. */
1972 x_set_tool_bar_lines (f
, value
, oldval
)
1974 Lisp_Object value
, oldval
;
1978 /* Use VALUE only if an integer >= 0. */
1979 if (INTEGERP (value
) && XINT (value
) >= 0)
1980 nlines
= XFASTINT (value
);
1984 /* Make sure we redisplay all windows in this frame. */
1985 ++windows_or_buffers_changed
;
1987 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1988 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1989 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f
), delta
);
1994 /* Set the foreground color for scroll bars on frame F to VALUE.
1995 VALUE should be a string, a color name. If it isn't a string or
1996 isn't a valid color name, do nothing. OLDVAL is the old value of
1997 the frame parameter. */
2000 x_set_scroll_bar_foreground (f
, value
, oldval
)
2002 Lisp_Object value
, oldval
;
2004 unsigned long pixel
;
2006 if (STRINGP (value
))
2007 pixel
= x_decode_color (f
, value
, BLACK_PIX_DEFAULT (f
));
2011 if (f
->output_data
.x
->scroll_bar_foreground_pixel
!= -1)
2012 unload_color (f
, f
->output_data
.x
->scroll_bar_foreground_pixel
);
2014 f
->output_data
.x
->scroll_bar_foreground_pixel
= pixel
;
2015 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2017 /* Remove all scroll bars because they have wrong colors. */
2018 if (condemn_scroll_bars_hook
)
2019 (*condemn_scroll_bars_hook
) (f
);
2020 if (judge_scroll_bars_hook
)
2021 (*judge_scroll_bars_hook
) (f
);
2023 update_face_from_frame_parameter (f
, Qscroll_bar_foreground
, value
);
2029 /* Set the background color for scroll bars on frame F to VALUE VALUE
2030 should be a string, a color name. If it isn't a string or isn't a
2031 valid color name, do nothing. OLDVAL is the old value of the frame
2035 x_set_scroll_bar_background (f
, value
, oldval
)
2037 Lisp_Object value
, oldval
;
2039 unsigned long pixel
;
2041 if (STRINGP (value
))
2042 pixel
= x_decode_color (f
, value
, WHITE_PIX_DEFAULT (f
));
2046 if (f
->output_data
.x
->scroll_bar_background_pixel
!= -1)
2047 unload_color (f
, f
->output_data
.x
->scroll_bar_background_pixel
);
2049 f
->output_data
.x
->scroll_bar_background_pixel
= pixel
;
2050 if (FRAME_X_WINDOW (f
) && FRAME_VISIBLE_P (f
))
2052 /* Remove all scroll bars because they have wrong colors. */
2053 if (condemn_scroll_bars_hook
)
2054 (*condemn_scroll_bars_hook
) (f
);
2055 if (judge_scroll_bars_hook
)
2056 (*judge_scroll_bars_hook
) (f
);
2058 update_face_from_frame_parameter (f
, Qscroll_bar_background
, value
);
2064 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2067 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2068 name; if NAME is a string, set F's name to NAME and set
2069 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2071 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2072 suggesting a new name, which lisp code should override; if
2073 F->explicit_name is set, ignore the new name; otherwise, set it. */
2076 x_set_name (f
, name
, explicit)
2081 /* Make sure that requests from lisp code override requests from
2082 Emacs redisplay code. */
2085 /* If we're switching from explicit to implicit, we had better
2086 update the mode lines and thereby update the title. */
2087 if (f
->explicit_name
&& NILP (name
))
2088 update_mode_lines
= 1;
2090 f
->explicit_name
= ! NILP (name
);
2092 else if (f
->explicit_name
)
2095 /* If NAME is nil, set the name to the x_id_name. */
2098 /* Check for no change needed in this very common case
2099 before we do any consing. */
2100 if (!strcmp (FRAME_X_DISPLAY_INFO (f
)->x_id_name
,
2101 XSTRING (f
->name
)->data
))
2103 name
= build_string (FRAME_X_DISPLAY_INFO (f
)->x_id_name
);
2106 CHECK_STRING (name
, 0);
2108 /* Don't change the name if it's already NAME. */
2109 if (! NILP (Fstring_equal (name
, f
->name
)))
2114 /* For setting the frame title, the title parameter should override
2115 the name parameter. */
2116 if (! NILP (f
->title
))
2119 if (FRAME_X_WINDOW (f
))
2124 XTextProperty text
, icon
;
2125 Lisp_Object icon_name
;
2127 text
.value
= XSTRING (name
)->data
;
2128 text
.encoding
= XA_STRING
;
2130 text
.nitems
= STRING_BYTES (XSTRING (name
));
2132 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2134 icon
.value
= XSTRING (icon_name
)->data
;
2135 icon
.encoding
= XA_STRING
;
2137 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2138 #ifdef USE_X_TOOLKIT
2139 XSetWMName (FRAME_X_DISPLAY (f
),
2140 XtWindow (f
->output_data
.x
->widget
), &text
);
2141 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2143 #else /* not USE_X_TOOLKIT */
2144 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2145 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2146 #endif /* not USE_X_TOOLKIT */
2148 #else /* not HAVE_X11R4 */
2149 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2150 XSTRING (name
)->data
);
2151 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2152 XSTRING (name
)->data
);
2153 #endif /* not HAVE_X11R4 */
2158 /* This function should be called when the user's lisp code has
2159 specified a name for the frame; the name will override any set by the
2162 x_explicitly_set_name (f
, arg
, oldval
)
2164 Lisp_Object arg
, oldval
;
2166 x_set_name (f
, arg
, 1);
2169 /* This function should be called by Emacs redisplay code to set the
2170 name; names set this way will never override names set by the user's
2173 x_implicitly_set_name (f
, arg
, oldval
)
2175 Lisp_Object arg
, oldval
;
2177 x_set_name (f
, arg
, 0);
2180 /* Change the title of frame F to NAME.
2181 If NAME is nil, use the frame name as the title.
2183 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2184 name; if NAME is a string, set F's name to NAME and set
2185 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2187 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2188 suggesting a new name, which lisp code should override; if
2189 F->explicit_name is set, ignore the new name; otherwise, set it. */
2192 x_set_title (f
, name
, old_name
)
2194 Lisp_Object name
, old_name
;
2196 /* Don't change the title if it's already NAME. */
2197 if (EQ (name
, f
->title
))
2200 update_mode_lines
= 1;
2207 CHECK_STRING (name
, 0);
2209 if (FRAME_X_WINDOW (f
))
2214 XTextProperty text
, icon
;
2215 Lisp_Object icon_name
;
2217 text
.value
= XSTRING (name
)->data
;
2218 text
.encoding
= XA_STRING
;
2220 text
.nitems
= STRING_BYTES (XSTRING (name
));
2222 icon_name
= (!NILP (f
->icon_name
) ? f
->icon_name
: name
);
2224 icon
.value
= XSTRING (icon_name
)->data
;
2225 icon
.encoding
= XA_STRING
;
2227 icon
.nitems
= STRING_BYTES (XSTRING (icon_name
));
2228 #ifdef USE_X_TOOLKIT
2229 XSetWMName (FRAME_X_DISPLAY (f
),
2230 XtWindow (f
->output_data
.x
->widget
), &text
);
2231 XSetWMIconName (FRAME_X_DISPLAY (f
), XtWindow (f
->output_data
.x
->widget
),
2233 #else /* not USE_X_TOOLKIT */
2234 XSetWMName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &text
);
2235 XSetWMIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &icon
);
2236 #endif /* not USE_X_TOOLKIT */
2238 #else /* not HAVE_X11R4 */
2239 XSetIconName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2240 XSTRING (name
)->data
);
2241 XStoreName (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2242 XSTRING (name
)->data
);
2243 #endif /* not HAVE_X11R4 */
2249 x_set_autoraise (f
, arg
, oldval
)
2251 Lisp_Object arg
, oldval
;
2253 f
->auto_raise
= !EQ (Qnil
, arg
);
2257 x_set_autolower (f
, arg
, oldval
)
2259 Lisp_Object arg
, oldval
;
2261 f
->auto_lower
= !EQ (Qnil
, arg
);
2265 x_set_unsplittable (f
, arg
, oldval
)
2267 Lisp_Object arg
, oldval
;
2269 f
->no_split
= !NILP (arg
);
2273 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2275 Lisp_Object arg
, oldval
;
2277 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2278 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2279 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2280 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2282 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
)
2284 ? vertical_scroll_bar_none
2286 ? vertical_scroll_bar_right
2287 : vertical_scroll_bar_left
);
2289 /* We set this parameter before creating the X window for the
2290 frame, so we can get the geometry right from the start.
2291 However, if the window hasn't been created yet, we shouldn't
2292 call x_set_window_size. */
2293 if (FRAME_X_WINDOW (f
))
2294 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2295 do_pending_window_change (0);
2300 x_set_scroll_bar_width (f
, arg
, oldval
)
2302 Lisp_Object arg
, oldval
;
2304 int wid
= FONT_WIDTH (f
->output_data
.x
->font
);
2308 #ifdef USE_TOOLKIT_SCROLL_BARS
2309 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2310 int width
= 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
;
2311 FRAME_SCROLL_BAR_COLS (f
) = (width
+ wid
- 1) / wid
;
2312 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = width
;
2314 /* Make the actual width at least 14 pixels and a multiple of a
2316 FRAME_SCROLL_BAR_COLS (f
) = (14 + wid
- 1) / wid
;
2318 /* Use all of that space (aside from required margins) for the
2320 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2323 if (FRAME_X_WINDOW (f
))
2324 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2325 do_pending_window_change (0);
2327 else if (INTEGERP (arg
) && XINT (arg
) > 0
2328 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2330 if (XFASTINT (arg
) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
)
2331 XSETINT (arg
, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM
+ 1);
2333 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2334 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2335 if (FRAME_X_WINDOW (f
))
2336 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2339 change_frame_size (f
, 0, FRAME_WIDTH (f
), 0, 0, 0);
2340 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.hpos
= 0;
2341 XWINDOW (FRAME_SELECTED_WINDOW (f
))->cursor
.x
= 0;
2346 /* Subroutines of creating an X frame. */
2348 /* Make sure that Vx_resource_name is set to a reasonable value.
2349 Fix it up, or set it to `emacs' if it is too hopeless. */
2352 validate_x_resource_name ()
2355 /* Number of valid characters in the resource name. */
2357 /* Number of invalid characters in the resource name. */
2362 if (!STRINGP (Vx_resource_class
))
2363 Vx_resource_class
= build_string (EMACS_CLASS
);
2365 if (STRINGP (Vx_resource_name
))
2367 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2370 len
= STRING_BYTES (XSTRING (Vx_resource_name
));
2372 /* Only letters, digits, - and _ are valid in resource names.
2373 Count the valid characters and count the invalid ones. */
2374 for (i
= 0; i
< len
; i
++)
2377 if (! ((c
>= 'a' && c
<= 'z')
2378 || (c
>= 'A' && c
<= 'Z')
2379 || (c
>= '0' && c
<= '9')
2380 || c
== '-' || c
== '_'))
2387 /* Not a string => completely invalid. */
2388 bad_count
= 5, good_count
= 0;
2390 /* If name is valid already, return. */
2394 /* If name is entirely invalid, or nearly so, use `emacs'. */
2396 || (good_count
== 1 && bad_count
> 0))
2398 Vx_resource_name
= build_string ("emacs");
2402 /* Name is partly valid. Copy it and replace the invalid characters
2403 with underscores. */
2405 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2407 for (i
= 0; i
< len
; i
++)
2409 int c
= XSTRING (new)->data
[i
];
2410 if (! ((c
>= 'a' && c
<= 'z')
2411 || (c
>= 'A' && c
<= 'Z')
2412 || (c
>= '0' && c
<= '9')
2413 || c
== '-' || c
== '_'))
2414 XSTRING (new)->data
[i
] = '_';
2419 extern char *x_get_string_resource ();
2421 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2422 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2423 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2424 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2425 the name specified by the `-name' or `-rn' command-line arguments.\n\
2427 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2428 class, respectively. You must specify both of them or neither.\n\
2429 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2430 and the class is `Emacs.CLASS.SUBCLASS'.")
2431 (attribute
, class, component
, subclass
)
2432 Lisp_Object attribute
, class, component
, subclass
;
2434 register char *value
;
2440 CHECK_STRING (attribute
, 0);
2441 CHECK_STRING (class, 0);
2443 if (!NILP (component
))
2444 CHECK_STRING (component
, 1);
2445 if (!NILP (subclass
))
2446 CHECK_STRING (subclass
, 2);
2447 if (NILP (component
) != NILP (subclass
))
2448 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2450 validate_x_resource_name ();
2452 /* Allocate space for the components, the dots which separate them,
2453 and the final '\0'. Make them big enough for the worst case. */
2454 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2455 + (STRINGP (component
)
2456 ? STRING_BYTES (XSTRING (component
)) : 0)
2457 + STRING_BYTES (XSTRING (attribute
))
2460 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2461 + STRING_BYTES (XSTRING (class))
2462 + (STRINGP (subclass
)
2463 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2466 /* Start with emacs.FRAMENAME for the name (the specific one)
2467 and with `Emacs' for the class key (the general one). */
2468 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2469 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2471 strcat (class_key
, ".");
2472 strcat (class_key
, XSTRING (class)->data
);
2474 if (!NILP (component
))
2476 strcat (class_key
, ".");
2477 strcat (class_key
, XSTRING (subclass
)->data
);
2479 strcat (name_key
, ".");
2480 strcat (name_key
, XSTRING (component
)->data
);
2483 strcat (name_key
, ".");
2484 strcat (name_key
, XSTRING (attribute
)->data
);
2486 value
= x_get_string_resource (check_x_display_info (Qnil
)->xrdb
,
2487 name_key
, class_key
);
2489 if (value
!= (char *) 0)
2490 return build_string (value
);
2495 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2498 display_x_get_resource (dpyinfo
, attribute
, class, component
, subclass
)
2499 struct x_display_info
*dpyinfo
;
2500 Lisp_Object attribute
, class, component
, subclass
;
2502 register char *value
;
2508 CHECK_STRING (attribute
, 0);
2509 CHECK_STRING (class, 0);
2511 if (!NILP (component
))
2512 CHECK_STRING (component
, 1);
2513 if (!NILP (subclass
))
2514 CHECK_STRING (subclass
, 2);
2515 if (NILP (component
) != NILP (subclass
))
2516 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2518 validate_x_resource_name ();
2520 /* Allocate space for the components, the dots which separate them,
2521 and the final '\0'. Make them big enough for the worst case. */
2522 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name
))
2523 + (STRINGP (component
)
2524 ? STRING_BYTES (XSTRING (component
)) : 0)
2525 + STRING_BYTES (XSTRING (attribute
))
2528 class_key
= (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class
))
2529 + STRING_BYTES (XSTRING (class))
2530 + (STRINGP (subclass
)
2531 ? STRING_BYTES (XSTRING (subclass
)) : 0)
2534 /* Start with emacs.FRAMENAME for the name (the specific one)
2535 and with `Emacs' for the class key (the general one). */
2536 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2537 strcpy (class_key
, XSTRING (Vx_resource_class
)->data
);
2539 strcat (class_key
, ".");
2540 strcat (class_key
, XSTRING (class)->data
);
2542 if (!NILP (component
))
2544 strcat (class_key
, ".");
2545 strcat (class_key
, XSTRING (subclass
)->data
);
2547 strcat (name_key
, ".");
2548 strcat (name_key
, XSTRING (component
)->data
);
2551 strcat (name_key
, ".");
2552 strcat (name_key
, XSTRING (attribute
)->data
);
2554 value
= x_get_string_resource (dpyinfo
->xrdb
, name_key
, class_key
);
2556 if (value
!= (char *) 0)
2557 return build_string (value
);
2562 /* Used when C code wants a resource value. */
2565 x_get_resource_string (attribute
, class)
2566 char *attribute
, *class;
2570 struct frame
*sf
= SELECTED_FRAME ();
2572 /* Allocate space for the components, the dots which separate them,
2573 and the final '\0'. */
2574 name_key
= (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name
))
2575 + strlen (attribute
) + 2);
2576 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2577 + strlen (class) + 2);
2579 sprintf (name_key
, "%s.%s",
2580 XSTRING (Vinvocation_name
)->data
,
2582 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2584 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf
)->xrdb
,
2585 name_key
, class_key
);
2588 /* Types we might convert a resource string into. */
2598 /* Return the value of parameter PARAM.
2600 First search ALIST, then Vdefault_frame_alist, then the X defaults
2601 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2603 Convert the resource to the type specified by desired_type.
2605 If no default is specified, return Qunbound. If you call
2606 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2607 and don't let it get stored in any Lisp-visible variables! */
2610 x_get_arg (dpyinfo
, alist
, param
, attribute
, class, type
)
2611 struct x_display_info
*dpyinfo
;
2612 Lisp_Object alist
, param
;
2615 enum resource_types type
;
2617 register Lisp_Object tem
;
2619 tem
= Fassq (param
, alist
);
2621 tem
= Fassq (param
, Vdefault_frame_alist
);
2627 tem
= display_x_get_resource (dpyinfo
,
2628 build_string (attribute
),
2629 build_string (class),
2637 case RES_TYPE_NUMBER
:
2638 return make_number (atoi (XSTRING (tem
)->data
));
2640 case RES_TYPE_FLOAT
:
2641 return make_float (atof (XSTRING (tem
)->data
));
2643 case RES_TYPE_BOOLEAN
:
2644 tem
= Fdowncase (tem
);
2645 if (!strcmp (XSTRING (tem
)->data
, "on")
2646 || !strcmp (XSTRING (tem
)->data
, "true"))
2651 case RES_TYPE_STRING
:
2654 case RES_TYPE_SYMBOL
:
2655 /* As a special case, we map the values `true' and `on'
2656 to Qt, and `false' and `off' to Qnil. */
2659 lower
= Fdowncase (tem
);
2660 if (!strcmp (XSTRING (lower
)->data
, "on")
2661 || !strcmp (XSTRING (lower
)->data
, "true"))
2663 else if (!strcmp (XSTRING (lower
)->data
, "off")
2664 || !strcmp (XSTRING (lower
)->data
, "false"))
2667 return Fintern (tem
, Qnil
);
2680 /* Like x_get_arg, but also record the value in f->param_alist. */
2683 x_get_and_record_arg (f
, alist
, param
, attribute
, class, type
)
2685 Lisp_Object alist
, param
;
2688 enum resource_types type
;
2692 value
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, param
,
2693 attribute
, class, type
);
2695 store_frame_param (f
, param
, value
);
2700 /* Record in frame F the specified or default value according to ALIST
2701 of the parameter named PROP (a Lisp symbol).
2702 If no value is specified for PROP, look for an X default for XPROP
2703 on the frame named NAME.
2704 If that is not found either, use the value DEFLT. */
2707 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2714 enum resource_types type
;
2718 tem
= x_get_arg (FRAME_X_DISPLAY_INFO (f
), alist
, prop
, xprop
, xclass
, type
);
2719 if (EQ (tem
, Qunbound
))
2721 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2726 /* Record in frame F the specified or default value according to ALIST
2727 of the parameter named PROP (a Lisp symbol). If no value is
2728 specified for PROP, look for an X default for XPROP on the frame
2729 named NAME. If that is not found either, use the value DEFLT. */
2732 x_default_scroll_bar_color_parameter (f
, alist
, prop
, xprop
, xclass
,
2741 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2744 tem
= x_get_arg (dpyinfo
, alist
, prop
, xprop
, xclass
, RES_TYPE_STRING
);
2745 if (EQ (tem
, Qunbound
))
2747 #ifdef USE_TOOLKIT_SCROLL_BARS
2749 /* See if an X resource for the scroll bar color has been
2751 tem
= display_x_get_resource (dpyinfo
,
2752 build_string (foreground_p
2756 build_string ("verticalScrollBar"),
2760 /* If nothing has been specified, scroll bars will use a
2761 toolkit-dependent default. Because these defaults are
2762 difficult to get at without actually creating a scroll
2763 bar, use nil to indicate that no color has been
2768 #else /* not USE_TOOLKIT_SCROLL_BARS */
2772 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2775 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2781 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2782 "Parse an X-style geometry string STRING.\n\
2783 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2784 The properties returned may include `top', `left', `height', and `width'.\n\
2785 The value of `left' or `top' may be an integer,\n\
2786 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2787 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2792 unsigned int width
, height
;
2795 CHECK_STRING (string
, 0);
2797 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2798 &x
, &y
, &width
, &height
);
2801 if (!!(geometry
& XValue
) != !!(geometry
& YValue
))
2802 error ("Must specify both x and y position, or neither");
2806 if (geometry
& XValue
)
2808 Lisp_Object element
;
2810 if (x
>= 0 && (geometry
& XNegative
))
2811 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2812 else if (x
< 0 && ! (geometry
& XNegative
))
2813 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2815 element
= Fcons (Qleft
, make_number (x
));
2816 result
= Fcons (element
, result
);
2819 if (geometry
& YValue
)
2821 Lisp_Object element
;
2823 if (y
>= 0 && (geometry
& YNegative
))
2824 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2825 else if (y
< 0 && ! (geometry
& YNegative
))
2826 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2828 element
= Fcons (Qtop
, make_number (y
));
2829 result
= Fcons (element
, result
);
2832 if (geometry
& WidthValue
)
2833 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2834 if (geometry
& HeightValue
)
2835 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2840 /* Calculate the desired size and position of this window,
2841 and return the flags saying which aspects were specified.
2843 This function does not make the coordinates positive. */
2845 #define DEFAULT_ROWS 40
2846 #define DEFAULT_COLS 80
2849 x_figure_window_size (f
, parms
)
2853 register Lisp_Object tem0
, tem1
, tem2
;
2854 long window_prompting
= 0;
2855 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2857 /* Default values if we fall through.
2858 Actually, if that happens we should get
2859 window manager prompting. */
2860 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2861 f
->height
= DEFAULT_ROWS
;
2862 /* Window managers expect that if program-specified
2863 positions are not (0,0), they're intentional, not defaults. */
2864 f
->output_data
.x
->top_pos
= 0;
2865 f
->output_data
.x
->left_pos
= 0;
2867 tem0
= x_get_arg (dpyinfo
, parms
, Qheight
, 0, 0, RES_TYPE_NUMBER
);
2868 tem1
= x_get_arg (dpyinfo
, parms
, Qwidth
, 0, 0, RES_TYPE_NUMBER
);
2869 tem2
= x_get_arg (dpyinfo
, parms
, Quser_size
, 0, 0, RES_TYPE_NUMBER
);
2870 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2872 if (!EQ (tem0
, Qunbound
))
2874 CHECK_NUMBER (tem0
, 0);
2875 f
->height
= XINT (tem0
);
2877 if (!EQ (tem1
, Qunbound
))
2879 CHECK_NUMBER (tem1
, 0);
2880 SET_FRAME_WIDTH (f
, XINT (tem1
));
2882 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2883 window_prompting
|= USSize
;
2885 window_prompting
|= PSize
;
2888 f
->output_data
.x
->vertical_scroll_bar_extra
2889 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2891 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.x
->font
)));
2892 f
->output_data
.x
->flags_areas_extra
2893 = FRAME_FLAGS_AREA_WIDTH (f
);
2894 f
->output_data
.x
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2895 f
->output_data
.x
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2897 tem0
= x_get_arg (dpyinfo
, parms
, Qtop
, 0, 0, RES_TYPE_NUMBER
);
2898 tem1
= x_get_arg (dpyinfo
, parms
, Qleft
, 0, 0, RES_TYPE_NUMBER
);
2899 tem2
= x_get_arg (dpyinfo
, parms
, Quser_position
, 0, 0, RES_TYPE_NUMBER
);
2900 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2902 if (EQ (tem0
, Qminus
))
2904 f
->output_data
.x
->top_pos
= 0;
2905 window_prompting
|= YNegative
;
2907 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qminus
)
2908 && CONSP (XCDR (tem0
))
2909 && INTEGERP (XCAR (XCDR (tem0
))))
2911 f
->output_data
.x
->top_pos
= - XINT (XCAR (XCDR (tem0
)));
2912 window_prompting
|= YNegative
;
2914 else if (CONSP (tem0
) && EQ (XCAR (tem0
), Qplus
)
2915 && CONSP (XCDR (tem0
))
2916 && INTEGERP (XCAR (XCDR (tem0
))))
2918 f
->output_data
.x
->top_pos
= XINT (XCAR (XCDR (tem0
)));
2920 else if (EQ (tem0
, Qunbound
))
2921 f
->output_data
.x
->top_pos
= 0;
2924 CHECK_NUMBER (tem0
, 0);
2925 f
->output_data
.x
->top_pos
= XINT (tem0
);
2926 if (f
->output_data
.x
->top_pos
< 0)
2927 window_prompting
|= YNegative
;
2930 if (EQ (tem1
, Qminus
))
2932 f
->output_data
.x
->left_pos
= 0;
2933 window_prompting
|= XNegative
;
2935 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qminus
)
2936 && CONSP (XCDR (tem1
))
2937 && INTEGERP (XCAR (XCDR (tem1
))))
2939 f
->output_data
.x
->left_pos
= - XINT (XCAR (XCDR (tem1
)));
2940 window_prompting
|= XNegative
;
2942 else if (CONSP (tem1
) && EQ (XCAR (tem1
), Qplus
)
2943 && CONSP (XCDR (tem1
))
2944 && INTEGERP (XCAR (XCDR (tem1
))))
2946 f
->output_data
.x
->left_pos
= XINT (XCAR (XCDR (tem1
)));
2948 else if (EQ (tem1
, Qunbound
))
2949 f
->output_data
.x
->left_pos
= 0;
2952 CHECK_NUMBER (tem1
, 0);
2953 f
->output_data
.x
->left_pos
= XINT (tem1
);
2954 if (f
->output_data
.x
->left_pos
< 0)
2955 window_prompting
|= XNegative
;
2958 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2959 window_prompting
|= USPosition
;
2961 window_prompting
|= PPosition
;
2964 return window_prompting
;
2967 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2970 XSetWMProtocols (dpy
, w
, protocols
, count
)
2977 prop
= XInternAtom (dpy
, "WM_PROTOCOLS", False
);
2978 if (prop
== None
) return False
;
2979 XChangeProperty (dpy
, w
, prop
, XA_ATOM
, 32, PropModeReplace
,
2980 (unsigned char *) protocols
, count
);
2983 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2985 #ifdef USE_X_TOOLKIT
2987 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
2988 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
2989 already be present because of the toolkit (Motif adds some of them,
2990 for example, but Xt doesn't). */
2993 hack_wm_protocols (f
, widget
)
2997 Display
*dpy
= XtDisplay (widget
);
2998 Window w
= XtWindow (widget
);
2999 int need_delete
= 1;
3005 Atom type
, *atoms
= 0;
3007 unsigned long nitems
= 0;
3008 unsigned long bytes_after
;
3010 if ((XGetWindowProperty (dpy
, w
,
3011 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3012 (long)0, (long)100, False
, XA_ATOM
,
3013 &type
, &format
, &nitems
, &bytes_after
,
3014 (unsigned char **) &atoms
)
3016 && format
== 32 && type
== XA_ATOM
)
3020 if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
)
3022 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
)
3024 else if (atoms
[nitems
] == FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
)
3027 if (atoms
) XFree ((char *) atoms
);
3033 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3035 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_take_focus
;
3037 props
[count
++] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3039 XChangeProperty (dpy
, w
, FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3040 XA_ATOM
, 32, PropModeAppend
,
3041 (unsigned char *) props
, count
);
3047 #ifdef USE_X_TOOLKIT
3049 /* Create and set up the X widget for frame F. */
3052 x_window (f
, window_prompting
, minibuffer_only
)
3054 long window_prompting
;
3055 int minibuffer_only
;
3057 XClassHint class_hints
;
3058 XSetWindowAttributes attributes
;
3059 unsigned long attribute_mask
;
3061 Widget shell_widget
;
3063 Widget frame_widget
;
3069 /* Use the resource name as the top-level widget name
3070 for looking up resources. Make a non-Lisp copy
3071 for the window manager, so GC relocation won't bother it.
3073 Elsewhere we specify the window name for the window manager. */
3076 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3077 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3078 strcpy (f
->namebuf
, str
);
3082 XtSetArg (al
[ac
], XtNallowShellResize
, 1); ac
++;
3083 XtSetArg (al
[ac
], XtNinput
, 1); ac
++;
3084 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3085 XtSetArg (al
[ac
], XtNborderWidth
, f
->output_data
.x
->border_width
); ac
++;
3086 shell_widget
= XtAppCreateShell (f
->namebuf
, EMACS_CLASS
,
3087 applicationShellWidgetClass
,
3088 FRAME_X_DISPLAY (f
), al
, ac
);
3090 f
->output_data
.x
->widget
= shell_widget
;
3091 /* maybe_set_screen_title_format (shell_widget); */
3093 pane_widget
= lw_create_widget ("main", "pane", widget_id_tick
++,
3094 (widget_value
*) NULL
,
3095 shell_widget
, False
,
3098 (lw_callback
) NULL
);
3100 f
->output_data
.x
->column_widget
= pane_widget
;
3102 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3103 the emacs screen when changing menubar. This reduces flickering. */
3106 XtSetArg (al
[ac
], XtNmappedWhenManaged
, 0); ac
++;
3107 XtSetArg (al
[ac
], XtNshowGrip
, 0); ac
++;
3108 XtSetArg (al
[ac
], XtNallowResize
, 1); ac
++;
3109 XtSetArg (al
[ac
], XtNresizeToPreferred
, 1); ac
++;
3110 XtSetArg (al
[ac
], XtNemacsFrame
, f
); ac
++;
3111 frame_widget
= XtCreateWidget (f
->namebuf
,
3113 pane_widget
, al
, ac
);
3115 f
->output_data
.x
->edit_widget
= frame_widget
;
3117 XtManageChild (frame_widget
);
3119 /* Do some needed geometry management. */
3122 char *tem
, shell_position
[32];
3125 int extra_borders
= 0;
3127 = (f
->output_data
.x
->menubar_widget
3128 ? (f
->output_data
.x
->menubar_widget
->core
.height
3129 + f
->output_data
.x
->menubar_widget
->core
.border_width
)
3132 #if 0 /* Experimentally, we now get the right results
3133 for -geometry -0-0 without this. 24 Aug 96, rms. */
3134 if (FRAME_EXTERNAL_MENU_BAR (f
))
3137 XtVaGetValues (pane_widget
, XtNinternalBorderWidth
, &ibw
, NULL
);
3138 menubar_size
+= ibw
;
3142 f
->output_data
.x
->menubar_height
= menubar_size
;
3145 /* Motif seems to need this amount added to the sizes
3146 specified for the shell widget. The Athena/Lucid widgets don't.
3147 Both conclusions reached experimentally. -- rms. */
3148 XtVaGetValues (f
->output_data
.x
->edit_widget
, XtNinternalBorderWidth
,
3149 &extra_borders
, NULL
);
3153 /* Convert our geometry parameters into a geometry string
3155 Note that we do not specify here whether the position
3156 is a user-specified or program-specified one.
3157 We pass that information later, in x_wm_set_size_hints. */
3159 int left
= f
->output_data
.x
->left_pos
;
3160 int xneg
= window_prompting
& XNegative
;
3161 int top
= f
->output_data
.x
->top_pos
;
3162 int yneg
= window_prompting
& YNegative
;
3168 if (window_prompting
& USPosition
)
3169 sprintf (shell_position
, "=%dx%d%c%d%c%d",
3170 PIXEL_WIDTH (f
) + extra_borders
,
3171 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
,
3172 (xneg
? '-' : '+'), left
,
3173 (yneg
? '-' : '+'), top
);
3175 sprintf (shell_position
, "=%dx%d",
3176 PIXEL_WIDTH (f
) + extra_borders
,
3177 PIXEL_HEIGHT (f
) + menubar_size
+ extra_borders
);
3180 len
= strlen (shell_position
) + 1;
3181 /* We don't free this because we don't know whether
3182 it is safe to free it while the frame exists.
3183 It isn't worth the trouble of arranging to free it
3184 when the frame is deleted. */
3185 tem
= (char *) xmalloc (len
);
3186 strncpy (tem
, shell_position
, len
);
3187 XtSetArg (al
[ac
], XtNgeometry
, tem
); ac
++;
3188 XtSetValues (shell_widget
, al
, ac
);
3191 XtManageChild (pane_widget
);
3192 XtRealizeWidget (shell_widget
);
3194 FRAME_X_WINDOW (f
) = XtWindow (frame_widget
);
3196 validate_x_resource_name ();
3198 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3199 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3200 XSetClassHint (FRAME_X_DISPLAY (f
), XtWindow (shell_widget
), &class_hints
);
3203 #ifndef X_I18N_INHIBITED
3208 xim
= XOpenIM (FRAME_X_DISPLAY (f
), NULL
, NULL
, NULL
);
3212 xic
= XCreateIC (xim
,
3213 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3214 XNClientWindow
, FRAME_X_WINDOW(f
),
3215 XNFocusWindow
, FRAME_X_WINDOW(f
),
3224 FRAME_XIM (f
) = xim
;
3225 FRAME_XIC (f
) = xic
;
3227 #else /* X_I18N_INHIBITED */
3230 #endif /* X_I18N_INHIBITED */
3231 #endif /* HAVE_X_I18N */
3233 f
->output_data
.x
->wm_hints
.input
= True
;
3234 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3235 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3236 &f
->output_data
.x
->wm_hints
);
3238 hack_wm_protocols (f
, shell_widget
);
3241 XtAddEventHandler (shell_widget
, 0, True
, _XEditResCheckMessages
, 0);
3244 /* Do a stupid property change to force the server to generate a
3245 PropertyNotify event so that the event_stream server timestamp will
3246 be initialized to something relevant to the time we created the window.
3248 XChangeProperty (XtDisplay (frame_widget
), XtWindow (frame_widget
),
3249 FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_protocols
,
3250 XA_ATOM
, 32, PropModeAppend
,
3251 (unsigned char*) NULL
, 0);
3253 /* Make all the standard events reach the Emacs frame. */
3254 attributes
.event_mask
= STANDARD_EVENT_SET
;
3255 attribute_mask
= CWEventMask
;
3256 XChangeWindowAttributes (XtDisplay (shell_widget
), XtWindow (shell_widget
),
3257 attribute_mask
, &attributes
);
3259 XtMapWidget (frame_widget
);
3261 /* x_set_name normally ignores requests to set the name if the
3262 requested name is the same as the current name. This is the one
3263 place where that assumption isn't correct; f->name is set, but
3264 the X server hasn't been told. */
3267 int explicit = f
->explicit_name
;
3269 f
->explicit_name
= 0;
3272 x_set_name (f
, name
, explicit);
3275 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3276 f
->output_data
.x
->text_cursor
);
3280 /* This is a no-op, except under Motif. Make sure main areas are
3281 set to something reasonable, in case we get an error later. */
3282 lw_set_main_areas (pane_widget
, 0, frame_widget
);
3285 #else /* not USE_X_TOOLKIT */
3287 /* Create and set up the X window for frame F. */
3294 XClassHint class_hints
;
3295 XSetWindowAttributes attributes
;
3296 unsigned long attribute_mask
;
3298 attributes
.background_pixel
= f
->output_data
.x
->background_pixel
;
3299 attributes
.border_pixel
= f
->output_data
.x
->border_pixel
;
3300 attributes
.bit_gravity
= StaticGravity
;
3301 attributes
.backing_store
= NotUseful
;
3302 attributes
.save_under
= True
;
3303 attributes
.event_mask
= STANDARD_EVENT_SET
;
3304 attribute_mask
= (CWBackPixel
| CWBorderPixel
| CWBitGravity
3306 | CWBackingStore
| CWSaveUnder
3312 = XCreateWindow (FRAME_X_DISPLAY (f
),
3313 f
->output_data
.x
->parent_desc
,
3314 f
->output_data
.x
->left_pos
,
3315 f
->output_data
.x
->top_pos
,
3316 PIXEL_WIDTH (f
), PIXEL_HEIGHT (f
),
3317 f
->output_data
.x
->border_width
,
3318 CopyFromParent
, /* depth */
3319 InputOutput
, /* class */
3320 FRAME_X_DISPLAY_INFO (f
)->visual
,
3321 attribute_mask
, &attributes
);
3323 #ifndef X_I18N_INHIBITED
3328 xim
= XOpenIM (FRAME_X_DISPLAY(f
), NULL
, NULL
, NULL
);
3332 xic
= XCreateIC (xim
,
3333 XNInputStyle
, XIMPreeditNothing
| XIMStatusNothing
,
3334 XNClientWindow
, FRAME_X_WINDOW(f
),
3335 XNFocusWindow
, FRAME_X_WINDOW(f
),
3345 FRAME_XIM (f
) = xim
;
3346 FRAME_XIC (f
) = xic
;
3348 #else /* X_I18N_INHIBITED */
3351 #endif /* X_I18N_INHIBITED */
3352 #endif /* HAVE_X_I18N */
3354 validate_x_resource_name ();
3356 class_hints
.res_name
= (char *) XSTRING (Vx_resource_name
)->data
;
3357 class_hints
.res_class
= (char *) XSTRING (Vx_resource_class
)->data
;
3358 XSetClassHint (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), &class_hints
);
3360 /* The menubar is part of the ordinary display;
3361 it does not count in addition to the height of the window. */
3362 f
->output_data
.x
->menubar_height
= 0;
3364 /* This indicates that we use the "Passive Input" input model.
3365 Unless we do this, we don't get the Focus{In,Out} events that we
3366 need to draw the cursor correctly. Accursed bureaucrats.
3367 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3369 f
->output_data
.x
->wm_hints
.input
= True
;
3370 f
->output_data
.x
->wm_hints
.flags
|= InputHint
;
3371 XSetWMHints (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3372 &f
->output_data
.x
->wm_hints
);
3373 f
->output_data
.x
->wm_hints
.icon_pixmap
= None
;
3375 /* Request "save yourself" and "delete window" commands from wm. */
3378 protocols
[0] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_delete_window
;
3379 protocols
[1] = FRAME_X_DISPLAY_INFO (f
)->Xatom_wm_save_yourself
;
3380 XSetWMProtocols (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), protocols
, 2);
3383 /* x_set_name normally ignores requests to set the name if the
3384 requested name is the same as the current name. This is the one
3385 place where that assumption isn't correct; f->name is set, but
3386 the X server hasn't been told. */
3389 int explicit = f
->explicit_name
;
3391 f
->explicit_name
= 0;
3394 x_set_name (f
, name
, explicit);
3397 XDefineCursor (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3398 f
->output_data
.x
->text_cursor
);
3402 if (FRAME_X_WINDOW (f
) == 0)
3403 error ("Unable to create window");
3406 #endif /* not USE_X_TOOLKIT */
3408 /* Handle the icon stuff for this window. Perhaps later we might
3409 want an x_set_icon_position which can be called interactively as
3417 Lisp_Object icon_x
, icon_y
;
3418 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3420 /* Set the position of the icon. Note that twm groups all
3421 icons in an icon window. */
3422 icon_x
= x_get_and_record_arg (f
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
3423 icon_y
= x_get_and_record_arg (f
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
3424 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3426 CHECK_NUMBER (icon_x
, 0);
3427 CHECK_NUMBER (icon_y
, 0);
3429 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3430 error ("Both left and top icon corners of icon must be specified");
3434 if (! EQ (icon_x
, Qunbound
))
3435 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3437 /* Start up iconic or window? */
3438 x_wm_set_window_state
3439 (f
, (EQ (x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
),
3444 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3451 /* Make the GC's needed for this window, setting the
3452 background, border and mouse colors; also create the
3453 mouse cursor and the gray border tile. */
3455 static char cursor_bits
[] =
3457 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3458 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3459 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3460 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3467 XGCValues gc_values
;
3471 /* Create the GC's of this frame.
3472 Note that many default values are used. */
3475 gc_values
.font
= f
->output_data
.x
->font
->fid
;
3476 gc_values
.foreground
= f
->output_data
.x
->foreground_pixel
;
3477 gc_values
.background
= f
->output_data
.x
->background_pixel
;
3478 gc_values
.line_width
= 0; /* Means 1 using fast algorithm. */
3479 f
->output_data
.x
->normal_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3481 GCLineWidth
| GCFont
3482 | GCForeground
| GCBackground
,
3485 /* Reverse video style. */
3486 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3487 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
3488 f
->output_data
.x
->reverse_gc
= XCreateGC (FRAME_X_DISPLAY (f
),
3490 GCFont
| GCForeground
| GCBackground
3494 /* Cursor has cursor-color background, background-color foreground. */
3495 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
3496 gc_values
.background
= f
->output_data
.x
->cursor_pixel
;
3497 gc_values
.fill_style
= FillOpaqueStippled
;
3499 = XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
3500 FRAME_X_DISPLAY_INFO (f
)->root_window
,
3501 cursor_bits
, 16, 16);
3502 f
->output_data
.x
->cursor_gc
3503 = XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
3504 (GCFont
| GCForeground
| GCBackground
3505 | GCFillStyle
/* | GCStipple */ | GCLineWidth
),
3509 f
->output_data
.x
->white_relief
.gc
= 0;
3510 f
->output_data
.x
->black_relief
.gc
= 0;
3512 /* Create the gray border tile used when the pointer is not in
3513 the frame. Since this depends on the frame's pixel values,
3514 this must be done on a per-frame basis. */
3515 f
->output_data
.x
->border_tile
3516 = (XCreatePixmapFromBitmapData
3517 (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
3518 gray_bits
, gray_width
, gray_height
,
3519 f
->output_data
.x
->foreground_pixel
,
3520 f
->output_data
.x
->background_pixel
,
3521 DefaultDepth (FRAME_X_DISPLAY (f
),
3522 XScreenNumberOfScreen (FRAME_X_SCREEN (f
)))));
3527 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3529 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3530 Returns an Emacs frame object.\n\
3531 ALIST is an alist of frame parameters.\n\
3532 If the parameters specify that the frame should not have a minibuffer,\n\
3533 and do not specify a specific minibuffer window to use,\n\
3534 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3535 be shared by the new frame.\n\
3537 This function is an internal primitive--use `make-frame' instead.")
3542 Lisp_Object frame
, tem
;
3544 int minibuffer_only
= 0;
3545 long window_prompting
= 0;
3547 int count
= specpdl_ptr
- specpdl
;
3548 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3549 Lisp_Object display
;
3550 struct x_display_info
*dpyinfo
= NULL
;
3556 /* Use this general default value to start with
3557 until we know if this frame has a specified name. */
3558 Vx_resource_name
= Vinvocation_name
;
3560 display
= x_get_arg (dpyinfo
, parms
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
3561 if (EQ (display
, Qunbound
))
3563 dpyinfo
= check_x_display_info (display
);
3565 kb
= dpyinfo
->kboard
;
3567 kb
= &the_only_kboard
;
3570 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
3572 && ! EQ (name
, Qunbound
)
3574 error ("Invalid frame name--not a string or nil");
3577 Vx_resource_name
= name
;
3579 /* See if parent window is specified. */
3580 parent
= x_get_arg (dpyinfo
, parms
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
3581 if (EQ (parent
, Qunbound
))
3583 if (! NILP (parent
))
3584 CHECK_NUMBER (parent
, 0);
3586 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3587 /* No need to protect DISPLAY because that's not used after passing
3588 it to make_frame_without_minibuffer. */
3590 GCPRO4 (parms
, parent
, name
, frame
);
3591 tem
= x_get_arg (dpyinfo
, parms
, Qminibuffer
, "minibuffer", "Minibuffer",
3593 if (EQ (tem
, Qnone
) || NILP (tem
))
3594 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3595 else if (EQ (tem
, Qonly
))
3597 f
= make_minibuffer_frame ();
3598 minibuffer_only
= 1;
3600 else if (WINDOWP (tem
))
3601 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3605 XSETFRAME (frame
, f
);
3607 /* Note that X Windows does support scroll bars. */
3608 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3610 f
->output_method
= output_x_window
;
3611 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
3612 bzero (f
->output_data
.x
, sizeof (struct x_output
));
3613 f
->output_data
.x
->icon_bitmap
= -1;
3614 f
->output_data
.x
->fontset
= -1;
3615 f
->output_data
.x
->scroll_bar_foreground_pixel
= -1;
3616 f
->output_data
.x
->scroll_bar_background_pixel
= -1;
3619 = x_get_arg (dpyinfo
, parms
, Qicon_name
, "iconName", "Title",
3621 if (! STRINGP (f
->icon_name
))
3622 f
->icon_name
= Qnil
;
3624 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
3626 FRAME_KBOARD (f
) = kb
;
3629 /* Specify the parent under which to make this X window. */
3633 f
->output_data
.x
->parent_desc
= (Window
) XFASTINT (parent
);
3634 f
->output_data
.x
->explicit_parent
= 1;
3638 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3639 f
->output_data
.x
->explicit_parent
= 0;
3642 /* Set the name; the functions to which we pass f expect the name to
3644 if (EQ (name
, Qunbound
) || NILP (name
))
3646 f
->name
= build_string (dpyinfo
->x_id_name
);
3647 f
->explicit_name
= 0;
3652 f
->explicit_name
= 1;
3653 /* use the frame's title when getting resources for this frame. */
3654 specbind (Qx_resource_name
, name
);
3657 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3658 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
3659 fs_register_fontset (f
, XCAR (tem
));
3661 /* Extract the window parameters from the supplied values
3662 that are needed to determine window geometry. */
3666 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
3669 /* First, try whatever font the caller has specified. */
3672 tem
= Fquery_fontset (font
, Qnil
);
3674 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
3676 font
= x_new_font (f
, XSTRING (font
)->data
);
3679 /* Try out a font which we hope has bold and italic variations. */
3680 if (!STRINGP (font
))
3681 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3682 if (!STRINGP (font
))
3683 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3684 if (! STRINGP (font
))
3685 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3686 if (! STRINGP (font
))
3687 /* This was formerly the first thing tried, but it finds too many fonts
3688 and takes too long. */
3689 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3690 /* If those didn't work, look for something which will at least work. */
3691 if (! STRINGP (font
))
3692 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3694 if (! STRINGP (font
))
3695 font
= build_string ("fixed");
3697 x_default_parameter (f
, parms
, Qfont
, font
,
3698 "font", "Font", RES_TYPE_STRING
);
3702 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3703 whereby it fails to get any font. */
3704 xlwmenu_default_font
= f
->output_data
.x
->font
;
3707 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3708 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
3710 /* This defaults to 2 in order to match xterm. We recognize either
3711 internalBorderWidth or internalBorder (which is what xterm calls
3713 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3717 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
3718 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
3719 if (! EQ (value
, Qunbound
))
3720 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3723 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
3724 "internalBorderWidth", "internalBorderWidth",
3726 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qleft
,
3727 "verticalScrollBars", "ScrollBars",
3730 /* Also do the stuff which must be set before the window exists. */
3731 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3732 "foreground", "Foreground", RES_TYPE_STRING
);
3733 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3734 "background", "Background", RES_TYPE_STRING
);
3735 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3736 "pointerColor", "Foreground", RES_TYPE_STRING
);
3737 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3738 "cursorColor", "Foreground", RES_TYPE_STRING
);
3739 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3740 "borderColor", "BorderColor", RES_TYPE_STRING
);
3741 x_default_parameter (f
, parms
, Qscreen_gamma
, Qnil
,
3742 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
3744 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_foreground
,
3745 "scrollBarForeground",
3746 "ScrollBarForeground", 1);
3747 x_default_scroll_bar_color_parameter (f
, parms
, Qscroll_bar_background
,
3748 "scrollBarBackground",
3749 "ScrollBarBackground", 0);
3751 /* Init faces before x_default_parameter is called for scroll-bar
3752 parameters because that function calls x_set_scroll_bar_width,
3753 which calls change_frame_size, which calls Fset_window_buffer,
3754 which runs hooks, which call Fvertical_motion. At the end, we
3755 end up in init_iterator with a null face cache, which should not
3757 init_frame_faces (f
);
3759 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3760 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
3761 x_default_parameter (f
, parms
, Qtool_bar_lines
, make_number (0),
3762 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
3763 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
3764 "bufferPredicate", "BufferPredicate",
3766 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
3767 "title", "Title", RES_TYPE_STRING
);
3769 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
3770 window_prompting
= x_figure_window_size (f
, parms
);
3772 if (window_prompting
& XNegative
)
3774 if (window_prompting
& YNegative
)
3775 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
3777 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
3781 if (window_prompting
& YNegative
)
3782 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
3784 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
3787 f
->output_data
.x
->size_hint_flags
= window_prompting
;
3789 tem
= x_get_arg (dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
3790 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3792 /* Create the X widget or window. Add the tool-bar height to the
3793 initial frame height so that the user gets a text display area of
3794 the size he specified with -g or via .Xdefaults. Later changes
3795 of the tool-bar height don't change the frame size. This is done
3796 so that users can create tall Emacs frames without having to
3797 guess how tall the tool-bar will get. */
3798 f
->height
+= FRAME_TOOL_BAR_LINES (f
);
3800 #ifdef USE_X_TOOLKIT
3801 x_window (f
, window_prompting
, minibuffer_only
);
3809 /* Now consider the frame official. */
3810 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
3811 Vframe_list
= Fcons (frame
, Vframe_list
);
3813 /* We need to do this after creating the X window, so that the
3814 icon-creation functions can say whose icon they're describing. */
3815 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3816 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
3818 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3819 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3820 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3821 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
3822 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3823 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
3824 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3825 "scrollBarWidth", "ScrollBarWidth",
3828 /* Dimensions, especially f->height, must be done via change_frame_size.
3829 Change will not be effected unless different from the current
3834 SET_FRAME_WIDTH (f
, 0);
3835 change_frame_size (f
, height
, width
, 1, 0, 0);
3837 /* Set up faces after all frame parameters are known. */
3838 call1 (Qface_set_after_frame_default
, frame
);
3840 #ifdef USE_X_TOOLKIT
3841 /* Create the menu bar. */
3842 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3844 /* If this signals an error, we haven't set size hints for the
3845 frame and we didn't make it visible. */
3846 initialize_frame_menubar (f
);
3848 /* This is a no-op, except under Motif where it arranges the
3849 main window for the widgets on it. */
3850 lw_set_main_areas (f
->output_data
.x
->column_widget
,
3851 f
->output_data
.x
->menubar_widget
,
3852 f
->output_data
.x
->edit_widget
);
3854 #endif /* USE_X_TOOLKIT */
3856 /* Tell the server what size and position, etc, we want, and how
3857 badly we want them. This should be done after we have the menu
3858 bar so that its size can be taken into account. */
3860 x_wm_set_size_hint (f
, window_prompting
, 0);
3863 /* Make the window appear on the frame and enable display, unless
3864 the caller says not to. However, with explicit parent, Emacs
3865 cannot control visibility, so don't try. */
3866 if (! f
->output_data
.x
->explicit_parent
)
3868 Lisp_Object visibility
;
3870 visibility
= x_get_arg (dpyinfo
, parms
, Qvisibility
, 0, 0,
3872 if (EQ (visibility
, Qunbound
))
3875 if (EQ (visibility
, Qicon
))
3876 x_iconify_frame (f
);
3877 else if (! NILP (visibility
))
3878 x_make_frame_visible (f
);
3880 /* Must have been Qnil. */
3885 return unbind_to (count
, frame
);
3888 /* FRAME is used only to get a handle on the X display. We don't pass the
3889 display info directly because we're called from frame.c, which doesn't
3890 know about that structure. */
3893 x_get_focus_frame (frame
)
3894 struct frame
*frame
;
3896 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (frame
);
3898 if (! dpyinfo
->x_focus_frame
)
3901 XSETFRAME (xfocus
, dpyinfo
->x_focus_frame
);
3906 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
3907 "Internal function called by `color-defined-p', which see.")
3909 Lisp_Object color
, frame
;
3912 FRAME_PTR f
= check_x_frame (frame
);
3914 CHECK_STRING (color
, 1);
3916 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3922 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
3923 "Internal function called by `color-values', which see.")
3925 Lisp_Object color
, frame
;
3928 FRAME_PTR f
= check_x_frame (frame
);
3930 CHECK_STRING (color
, 1);
3932 if (x_defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
3936 rgb
[0] = make_number (foo
.red
);
3937 rgb
[1] = make_number (foo
.green
);
3938 rgb
[2] = make_number (foo
.blue
);
3939 return Flist (3, rgb
);
3945 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
3946 "Internal function called by `display-color-p', which see.")
3948 Lisp_Object display
;
3950 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3952 if (dpyinfo
->n_planes
<= 2)
3955 switch (dpyinfo
->visual
->class)
3968 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
3970 "Return t if the X display supports shades of gray.\n\
3971 Note that color displays do support shades of gray.\n\
3972 The optional argument DISPLAY specifies which display to ask about.\n\
3973 DISPLAY should be either a frame or a display name (a string).\n\
3974 If omitted or nil, that stands for the selected frame's display.")
3976 Lisp_Object display
;
3978 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
3980 if (dpyinfo
->n_planes
<= 1)
3983 switch (dpyinfo
->visual
->class)
3998 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4000 "Returns the width in pixels of the X display DISPLAY.\n\
4001 The optional argument DISPLAY specifies which display to ask about.\n\
4002 DISPLAY should be either a frame or a display name (a string).\n\
4003 If omitted or nil, that stands for the selected frame's display.")
4005 Lisp_Object display
;
4007 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4009 return make_number (dpyinfo
->width
);
4012 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4013 Sx_display_pixel_height
, 0, 1, 0,
4014 "Returns the height in pixels of the X display DISPLAY.\n\
4015 The optional argument DISPLAY specifies which display to ask about.\n\
4016 DISPLAY should be either a frame or a display name (a string).\n\
4017 If omitted or nil, that stands for the selected frame's display.")
4019 Lisp_Object display
;
4021 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4023 return make_number (dpyinfo
->height
);
4026 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4028 "Returns the number of bitplanes of the X display DISPLAY.\n\
4029 The optional argument DISPLAY specifies which display to ask about.\n\
4030 DISPLAY should be either a frame or a display name (a string).\n\
4031 If omitted or nil, that stands for the selected frame's display.")
4033 Lisp_Object display
;
4035 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4037 return make_number (dpyinfo
->n_planes
);
4040 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4042 "Returns the number of color cells of the X display DISPLAY.\n\
4043 The optional argument DISPLAY specifies which display to ask about.\n\
4044 DISPLAY should be either a frame or a display name (a string).\n\
4045 If omitted or nil, that stands for the selected frame's display.")
4047 Lisp_Object display
;
4049 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4051 return make_number (DisplayCells (dpyinfo
->display
,
4052 XScreenNumberOfScreen (dpyinfo
->screen
)));
4055 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4056 Sx_server_max_request_size
,
4058 "Returns the maximum request size of the X server of display DISPLAY.\n\
4059 The optional argument DISPLAY specifies which display to ask about.\n\
4060 DISPLAY should be either a frame or a display name (a string).\n\
4061 If omitted or nil, that stands for the selected frame's display.")
4063 Lisp_Object display
;
4065 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4067 return make_number (MAXREQUEST (dpyinfo
->display
));
4070 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4071 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4072 The optional argument DISPLAY specifies which display to ask about.\n\
4073 DISPLAY should be either a frame or a display name (a string).\n\
4074 If omitted or nil, that stands for the selected frame's display.")
4076 Lisp_Object display
;
4078 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4079 char *vendor
= ServerVendor (dpyinfo
->display
);
4081 if (! vendor
) vendor
= "";
4082 return build_string (vendor
);
4085 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4086 "Returns the version numbers of the X server of display DISPLAY.\n\
4087 The value is a list of three integers: the major and minor\n\
4088 version numbers of the X Protocol in use, and the vendor-specific release\n\
4089 number. See also the function `x-server-vendor'.\n\n\
4090 The optional argument DISPLAY specifies which display to ask about.\n\
4091 DISPLAY should be either a frame or a display name (a string).\n\
4092 If omitted or nil, that stands for the selected frame's display.")
4094 Lisp_Object display
;
4096 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4097 Display
*dpy
= dpyinfo
->display
;
4099 return Fcons (make_number (ProtocolVersion (dpy
)),
4100 Fcons (make_number (ProtocolRevision (dpy
)),
4101 Fcons (make_number (VendorRelease (dpy
)), Qnil
)));
4104 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4105 "Returns the number of screens on the X server of display DISPLAY.\n\
4106 The optional argument DISPLAY specifies which display to ask about.\n\
4107 DISPLAY should be either a frame or a display name (a string).\n\
4108 If omitted or nil, that stands for the selected frame's display.")
4110 Lisp_Object display
;
4112 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4114 return make_number (ScreenCount (dpyinfo
->display
));
4117 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4118 "Returns the height in millimeters of the X display DISPLAY.\n\
4119 The optional argument DISPLAY specifies which display to ask about.\n\
4120 DISPLAY should be either a frame or a display name (a string).\n\
4121 If omitted or nil, that stands for the selected frame's display.")
4123 Lisp_Object display
;
4125 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4127 return make_number (HeightMMOfScreen (dpyinfo
->screen
));
4130 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4131 "Returns the width in millimeters of the X display DISPLAY.\n\
4132 The optional argument DISPLAY specifies which display to ask about.\n\
4133 DISPLAY should be either a frame or a display name (a string).\n\
4134 If omitted or nil, that stands for the selected frame's display.")
4136 Lisp_Object display
;
4138 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4140 return make_number (WidthMMOfScreen (dpyinfo
->screen
));
4143 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4144 Sx_display_backing_store
, 0, 1, 0,
4145 "Returns an indication of whether X display DISPLAY does backing store.\n\
4146 The value may be `always', `when-mapped', or `not-useful'.\n\
4147 The optional argument DISPLAY specifies which display to ask about.\n\
4148 DISPLAY should be either a frame or a display name (a string).\n\
4149 If omitted or nil, that stands for the selected frame's display.")
4151 Lisp_Object display
;
4153 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4155 switch (DoesBackingStore (dpyinfo
->screen
))
4158 return intern ("always");
4161 return intern ("when-mapped");
4164 return intern ("not-useful");
4167 error ("Strange value for BackingStore parameter of screen");
4171 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4172 Sx_display_visual_class
, 0, 1, 0,
4173 "Returns the visual class of the X display DISPLAY.\n\
4174 The value is one of the symbols `static-gray', `gray-scale',\n\
4175 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4176 The optional argument DISPLAY specifies which display to ask about.\n\
4177 DISPLAY should be either a frame or a display name (a string).\n\
4178 If omitted or nil, that stands for the selected frame's display.")
4180 Lisp_Object display
;
4182 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4184 switch (dpyinfo
->visual
->class)
4186 case StaticGray
: return (intern ("static-gray"));
4187 case GrayScale
: return (intern ("gray-scale"));
4188 case StaticColor
: return (intern ("static-color"));
4189 case PseudoColor
: return (intern ("pseudo-color"));
4190 case TrueColor
: return (intern ("true-color"));
4191 case DirectColor
: return (intern ("direct-color"));
4193 error ("Display has an unknown visual class");
4197 DEFUN ("x-display-save-under", Fx_display_save_under
,
4198 Sx_display_save_under
, 0, 1, 0,
4199 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4200 The optional argument DISPLAY specifies which display to ask about.\n\
4201 DISPLAY should be either a frame or a display name (a string).\n\
4202 If omitted or nil, that stands for the selected frame's display.")
4204 Lisp_Object display
;
4206 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
4208 if (DoesSaveUnders (dpyinfo
->screen
) == True
)
4216 register struct frame
*f
;
4218 return PIXEL_WIDTH (f
);
4223 register struct frame
*f
;
4225 return PIXEL_HEIGHT (f
);
4230 register struct frame
*f
;
4232 return FONT_WIDTH (f
->output_data
.x
->font
);
4237 register struct frame
*f
;
4239 return f
->output_data
.x
->line_height
;
4244 register struct frame
*f
;
4246 return FRAME_X_DISPLAY_INFO (f
)->n_planes
;
4249 #if 0 /* These no longer seem like the right way to do things. */
4251 /* Draw a rectangle on the frame with left top corner including
4252 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4253 CHARS by LINES wide and long and is the color of the cursor. */
4256 x_rectangle (f
, gc
, left_char
, top_char
, chars
, lines
)
4257 register struct frame
*f
;
4259 register int top_char
, left_char
, chars
, lines
;
4263 int left
= (left_char
* FONT_WIDTH (f
->output_data
.x
->font
)
4264 + f
->output_data
.x
->internal_border_width
);
4265 int top
= (top_char
* f
->output_data
.x
->line_height
4266 + f
->output_data
.x
->internal_border_width
);
4269 width
= FONT_WIDTH (f
->output_data
.x
->font
) / 2;
4271 width
= FONT_WIDTH (f
->output_data
.x
->font
) * chars
;
4273 height
= f
->output_data
.x
->line_height
/ 2;
4275 height
= f
->output_data
.x
->line_height
* lines
;
4277 XDrawRectangle (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4278 gc
, left
, top
, width
, height
);
4281 DEFUN ("x-draw-rectangle", Fx_draw_rectangle
, Sx_draw_rectangle
, 5, 5, 0,
4282 "Draw a rectangle on FRAME between coordinates specified by\n\
4283 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4284 (frame
, X0
, Y0
, X1
, Y1
)
4285 register Lisp_Object frame
, X0
, X1
, Y0
, Y1
;
4287 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4289 CHECK_LIVE_FRAME (frame
, 0);
4290 CHECK_NUMBER (X0
, 0);
4291 CHECK_NUMBER (Y0
, 1);
4292 CHECK_NUMBER (X1
, 2);
4293 CHECK_NUMBER (Y1
, 3);
4303 n_lines
= y1
- y0
+ 1;
4308 n_lines
= y0
- y1
+ 1;
4314 n_chars
= x1
- x0
+ 1;
4319 n_chars
= x0
- x1
+ 1;
4323 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->cursor_gc
,
4324 left
, top
, n_chars
, n_lines
);
4330 DEFUN ("x-erase-rectangle", Fx_erase_rectangle
, Sx_erase_rectangle
, 5, 5, 0,
4331 "Draw a rectangle drawn on FRAME between coordinates\n\
4332 X0, Y0, X1, Y1 in the regular background-pixel.")
4333 (frame
, X0
, Y0
, X1
, Y1
)
4334 register Lisp_Object frame
, X0
, Y0
, X1
, Y1
;
4336 register int x0
, y0
, x1
, y1
, top
, left
, n_chars
, n_lines
;
4338 CHECK_LIVE_FRAME (frame
, 0);
4339 CHECK_NUMBER (X0
, 0);
4340 CHECK_NUMBER (Y0
, 1);
4341 CHECK_NUMBER (X1
, 2);
4342 CHECK_NUMBER (Y1
, 3);
4352 n_lines
= y1
- y0
+ 1;
4357 n_lines
= y0
- y1
+ 1;
4363 n_chars
= x1
- x0
+ 1;
4368 n_chars
= x0
- x1
+ 1;
4372 x_rectangle (XFRAME (frame
), XFRAME (frame
)->output_data
.x
->reverse_gc
,
4373 left
, top
, n_chars
, n_lines
);
4379 /* Draw lines around the text region beginning at the character position
4380 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4381 pixel and line characteristics. */
4383 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4386 outline_region (f
, gc
, top_x
, top_y
, bottom_x
, bottom_y
)
4387 register struct frame
*f
;
4389 int top_x
, top_y
, bottom_x
, bottom_y
;
4391 register int ibw
= f
->output_data
.x
->internal_border_width
;
4392 register int font_w
= FONT_WIDTH (f
->output_data
.x
->font
);
4393 register int font_h
= f
->output_data
.x
->line_height
;
4395 int x
= line_len (y
);
4396 XPoint
*pixel_points
4397 = (XPoint
*) alloca (((bottom_y
- top_y
+ 2) * 4) * sizeof (XPoint
));
4398 register XPoint
*this_point
= pixel_points
;
4400 /* Do the horizontal top line/lines */
4403 this_point
->x
= ibw
;
4404 this_point
->y
= ibw
+ (font_h
* top_y
);
4407 this_point
->x
= ibw
+ (font_w
/ 2); /* Half-size for newline chars. */
4409 this_point
->x
= ibw
+ (font_w
* x
);
4410 this_point
->y
= (this_point
- 1)->y
;
4414 this_point
->x
= ibw
;
4415 this_point
->y
= ibw
+ (font_h
* (top_y
+ 1));
4417 this_point
->x
= ibw
+ (font_w
* top_x
);
4418 this_point
->y
= (this_point
- 1)->y
;
4420 this_point
->x
= (this_point
- 1)->x
;
4421 this_point
->y
= ibw
+ (font_h
* top_y
);
4423 this_point
->x
= ibw
+ (font_w
* x
);
4424 this_point
->y
= (this_point
- 1)->y
;
4427 /* Now do the right side. */
4428 while (y
< bottom_y
)
4429 { /* Right vertical edge */
4431 this_point
->x
= (this_point
- 1)->x
;
4432 this_point
->y
= ibw
+ (font_h
* (y
+ 1));
4435 y
++; /* Horizontal connection to next line */
4438 this_point
->x
= ibw
+ (font_w
/ 2);
4440 this_point
->x
= ibw
+ (font_w
* x
);
4442 this_point
->y
= (this_point
- 1)->y
;
4445 /* Now do the bottom and connect to the top left point. */
4446 this_point
->x
= ibw
+ (font_w
* (bottom_x
+ 1));
4449 this_point
->x
= (this_point
- 1)->x
;
4450 this_point
->y
= ibw
+ (font_h
* (bottom_y
+ 1));
4452 this_point
->x
= ibw
;
4453 this_point
->y
= (this_point
- 1)->y
;
4455 this_point
->x
= pixel_points
->x
;
4456 this_point
->y
= pixel_points
->y
;
4458 XDrawLines (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4460 (this_point
- pixel_points
+ 1), CoordModeOrigin
);
4463 DEFUN ("x-contour-region", Fx_contour_region
, Sx_contour_region
, 1, 1, 0,
4464 "Highlight the region between point and the character under the mouse\n\
4467 register Lisp_Object event
;
4469 register int x0
, y0
, x1
, y1
;
4470 register struct frame
*f
= selected_frame
;
4471 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4472 register int p1
, p2
;
4474 CHECK_CONS (event
, 0);
4477 x0
= XINT (Fcar (Fcar (event
)));
4478 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4480 /* If the mouse is past the end of the line, don't that area. */
4481 /* ReWrite this... */
4483 /* Where the cursor is. */
4484 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4485 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4487 if (y1
> y0
) /* point below mouse */
4488 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4490 else if (y1
< y0
) /* point above mouse */
4491 outline_region (f
, f
->output_data
.x
->cursor_gc
,
4493 else /* same line: draw horizontal rectangle */
4496 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4497 x0
, y0
, (x1
- x0
+ 1), 1);
4499 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4500 x1
, y1
, (x0
- x1
+ 1), 1);
4503 XFlush (FRAME_X_DISPLAY (f
));
4509 DEFUN ("x-uncontour-region", Fx_uncontour_region
, Sx_uncontour_region
, 1, 1, 0,
4510 "Erase any highlighting of the region between point and the character\n\
4511 at X, Y on the selected frame.")
4513 register Lisp_Object event
;
4515 register int x0
, y0
, x1
, y1
;
4516 register struct frame
*f
= selected_frame
;
4517 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4520 x0
= XINT (Fcar (Fcar (event
)));
4521 y0
= XINT (Fcar (Fcdr (Fcar (event
))));
4522 x1
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4523 y1
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4525 if (y1
> y0
) /* point below mouse */
4526 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4528 else if (y1
< y0
) /* point above mouse */
4529 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4531 else /* same line: draw horizontal rectangle */
4534 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4535 x0
, y0
, (x1
- x0
+ 1), 1);
4537 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4538 x1
, y1
, (x0
- x1
+ 1), 1);
4546 int contour_begin_x
, contour_begin_y
;
4547 int contour_end_x
, contour_end_y
;
4548 int contour_npoints
;
4550 /* Clip the top part of the contour lines down (and including) line Y_POS.
4551 If X_POS is in the middle (rather than at the end) of the line, drop
4552 down a line at that character. */
4555 clip_contour_top (y_pos
, x_pos
)
4557 register XPoint
*begin
= contour_lines
[y_pos
].top_left
;
4558 register XPoint
*end
;
4559 register int npoints
;
4560 register struct display_line
*line
= selected_frame
->phys_lines
[y_pos
+ 1];
4562 if (x_pos
>= line
->len
- 1) /* Draw one, straight horizontal line. */
4564 end
= contour_lines
[y_pos
].top_right
;
4565 npoints
= (end
- begin
+ 1);
4566 XDrawLines (x_current_display
, contour_window
,
4567 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4569 bcopy (end
, begin
+ 1, contour_last_point
- end
+ 1);
4570 contour_last_point
-= (npoints
- 2);
4571 XDrawLines (x_current_display
, contour_window
,
4572 contour_erase_gc
, begin
, 2, CoordModeOrigin
);
4573 XFlush (x_current_display
);
4575 /* Now, update contour_lines structure. */
4580 register XPoint
*p
= begin
+ 1;
4581 end
= contour_lines
[y_pos
].bottom_right
;
4582 npoints
= (end
- begin
+ 1);
4583 XDrawLines (x_current_display
, contour_window
,
4584 contour_erase_gc
, begin_erase
, npoints
, CoordModeOrigin
);
4587 p
->x
= ibw
+ (font_w
* (x_pos
+ 1));
4589 p
->y
= begin
->y
+ font_h
;
4591 bcopy (end
, begin
+ 3, contour_last_point
- end
+ 1);
4592 contour_last_point
-= (npoints
- 5);
4593 XDrawLines (x_current_display
, contour_window
,
4594 contour_erase_gc
, begin
, 4, CoordModeOrigin
);
4595 XFlush (x_current_display
);
4597 /* Now, update contour_lines structure. */
4601 /* Erase the top horizontal lines of the contour, and then extend
4602 the contour upwards. */
4605 extend_contour_top (line
)
4610 clip_contour_bottom (x_pos
, y_pos
)
4616 extend_contour_bottom (x_pos
, y_pos
)
4620 DEFUN ("x-select-region", Fx_select_region
, Sx_select_region
, 1, 1, "e",
4625 register struct frame
*f
= selected_frame
;
4626 struct window
*w
= XWINDOW (FRAME_SELECTED_WINDOW (f
));
4627 register int point_x
= WINDOW_TO_FRAME_PIXEL_X (w
, w
->cursor
.x
);
4628 register int point_y
= WINDOW_TO_FRAME_PIXEL_Y (w
, w
->cursor
.y
);
4629 register int mouse_below_point
;
4630 register Lisp_Object obj
;
4631 register int x_contour_x
, x_contour_y
;
4633 x_contour_x
= x_mouse_x
;
4634 x_contour_y
= x_mouse_y
;
4635 if (x_contour_y
> point_y
|| (x_contour_y
== point_y
4636 && x_contour_x
> point_x
))
4638 mouse_below_point
= 1;
4639 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4640 x_contour_x
, x_contour_y
);
4644 mouse_below_point
= 0;
4645 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_contour_x
, x_contour_y
,
4651 obj
= read_char (-1, 0, 0, Qnil
, 0);
4655 if (mouse_below_point
)
4657 if (x_mouse_y
<= point_y
) /* Flipped. */
4659 mouse_below_point
= 0;
4661 outline_region (f
, f
->output_data
.x
->reverse_gc
, point_x
, point_y
,
4662 x_contour_x
, x_contour_y
);
4663 outline_region (f
, f
->output_data
.x
->cursor_gc
, x_mouse_x
, x_mouse_y
,
4666 else if (x_mouse_y
< x_contour_y
) /* Bottom clipped. */
4668 clip_contour_bottom (x_mouse_y
);
4670 else if (x_mouse_y
> x_contour_y
) /* Bottom extended. */
4672 extend_bottom_contour (x_mouse_y
);
4675 x_contour_x
= x_mouse_x
;
4676 x_contour_y
= x_mouse_y
;
4678 else /* mouse above or same line as point */
4680 if (x_mouse_y
>= point_y
) /* Flipped. */
4682 mouse_below_point
= 1;
4684 outline_region (f
, f
->output_data
.x
->reverse_gc
,
4685 x_contour_x
, x_contour_y
, point_x
, point_y
);
4686 outline_region (f
, f
->output_data
.x
->cursor_gc
, point_x
, point_y
,
4687 x_mouse_x
, x_mouse_y
);
4689 else if (x_mouse_y
> x_contour_y
) /* Top clipped. */
4691 clip_contour_top (x_mouse_y
);
4693 else if (x_mouse_y
< x_contour_y
) /* Top extended. */
4695 extend_contour_top (x_mouse_y
);
4700 unread_command_event
= obj
;
4701 if (mouse_below_point
)
4703 contour_begin_x
= point_x
;
4704 contour_begin_y
= point_y
;
4705 contour_end_x
= x_contour_x
;
4706 contour_end_y
= x_contour_y
;
4710 contour_begin_x
= x_contour_x
;
4711 contour_begin_y
= x_contour_y
;
4712 contour_end_x
= point_x
;
4713 contour_end_y
= point_y
;
4718 DEFUN ("x-horizontal-line", Fx_horizontal_line
, Sx_horizontal_line
, 1, 1, "e",
4723 register Lisp_Object obj
;
4724 struct frame
*f
= selected_frame
;
4725 register struct window
*w
= XWINDOW (selected_window
);
4726 register GC line_gc
= f
->output_data
.x
->cursor_gc
;
4727 register GC erase_gc
= f
->output_data
.x
->reverse_gc
;
4729 char dash_list
[] = {6, 4, 6, 4};
4731 XGCValues gc_values
;
4733 register int previous_y
;
4734 register int line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4735 + f
->output_data
.x
->internal_border_width
;
4736 register int left
= f
->output_data
.x
->internal_border_width
4737 + (WINDOW_LEFT_MARGIN (w
)
4738 * FONT_WIDTH (f
->output_data
.x
->font
));
4739 register int right
= left
+ (w
->width
4740 * FONT_WIDTH (f
->output_data
.x
->font
))
4741 - f
->output_data
.x
->internal_border_width
;
4745 gc_values
.foreground
= f
->output_data
.x
->cursor_pixel
;
4746 gc_values
.background
= f
->output_data
.x
->background_pixel
;
4747 gc_values
.line_width
= 1;
4748 gc_values
.line_style
= LineOnOffDash
;
4749 gc_values
.cap_style
= CapRound
;
4750 gc_values
.join_style
= JoinRound
;
4752 line_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4753 GCLineStyle
| GCJoinStyle
| GCCapStyle
4754 | GCLineWidth
| GCForeground
| GCBackground
,
4756 XSetDashes (FRAME_X_DISPLAY (f
), line_gc
, 0, dash_list
, dashes
);
4757 gc_values
.foreground
= f
->output_data
.x
->background_pixel
;
4758 gc_values
.background
= f
->output_data
.x
->foreground_pixel
;
4759 erase_gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4760 GCLineStyle
| GCJoinStyle
| GCCapStyle
4761 | GCLineWidth
| GCForeground
| GCBackground
,
4763 XSetDashes (FRAME_X_DISPLAY (f
), erase_gc
, 0, dash_list
, dashes
);
4770 if (x_mouse_y
>= XINT (w
->top
)
4771 && x_mouse_y
< XINT (w
->top
) + XINT (w
->height
) - 1)
4773 previous_y
= x_mouse_y
;
4774 line
= (x_mouse_y
+ 1) * f
->output_data
.x
->line_height
4775 + f
->output_data
.x
->internal_border_width
;
4776 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4777 line_gc
, left
, line
, right
, line
);
4779 XFlush (FRAME_X_DISPLAY (f
));
4784 obj
= read_char (-1, 0, 0, Qnil
, 0);
4786 || (! EQ (Fcar (Fcdr (Fcdr (obj
))),
4787 Qvertical_scroll_bar
))
4791 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4792 erase_gc
, left
, line
, right
, line
);
4793 unread_command_event
= obj
;
4795 XFreeGC (FRAME_X_DISPLAY (f
), line_gc
);
4796 XFreeGC (FRAME_X_DISPLAY (f
), erase_gc
);
4802 while (x_mouse_y
== previous_y
);
4805 XDrawLine (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
4806 erase_gc
, left
, line
, right
, line
);
4813 /* These keep track of the rectangle following the pointer. */
4814 int mouse_track_top
, mouse_track_left
, mouse_track_width
;
4816 /* Offset in buffer of character under the pointer, or 0. */
4817 int mouse_buffer_offset
;
4819 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 0, 0, 0,
4820 "Track the pointer.")
4823 static Cursor current_pointer_shape
;
4824 FRAME_PTR f
= x_mouse_frame
;
4827 if (EQ (Vmouse_frame_part
, Qtext_part
)
4828 && (current_pointer_shape
!= f
->output_data
.x
->nontext_cursor
))
4833 current_pointer_shape
= f
->output_data
.x
->nontext_cursor
;
4834 XDefineCursor (FRAME_X_DISPLAY (f
),
4836 current_pointer_shape
);
4838 buf
= XBUFFER (XWINDOW (Vmouse_window
)->buffer
);
4839 c
= *(BUF_CHAR_ADDRESS (buf
, mouse_buffer_offset
));
4841 else if (EQ (Vmouse_frame_part
, Qmodeline_part
)
4842 && (current_pointer_shape
!= f
->output_data
.x
->modeline_cursor
))
4844 current_pointer_shape
= f
->output_data
.x
->modeline_cursor
;
4845 XDefineCursor (FRAME_X_DISPLAY (f
),
4847 current_pointer_shape
);
4850 XFlush (FRAME_X_DISPLAY (f
));
4856 DEFUN ("x-track-pointer", Fx_track_pointer
, Sx_track_pointer
, 1, 1, "e",
4857 "Draw rectangle around character under mouse pointer, if there is one.")
4861 struct window
*w
= XWINDOW (Vmouse_window
);
4862 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
4863 struct buffer
*b
= XBUFFER (w
->buffer
);
4866 if (! EQ (Vmouse_window
, selected_window
))
4869 if (EQ (event
, Qnil
))
4873 x_read_mouse_position (selected_frame
, &x
, &y
);
4877 mouse_track_width
= 0;
4878 mouse_track_left
= mouse_track_top
= -1;
4882 if ((x_mouse_x
!= mouse_track_left
4883 && (x_mouse_x
< mouse_track_left
4884 || x_mouse_x
> (mouse_track_left
+ mouse_track_width
)))
4885 || x_mouse_y
!= mouse_track_top
)
4887 int hp
= 0; /* Horizontal position */
4888 int len
= FRAME_CURRENT_GLYPHS (f
)->used
[x_mouse_y
];
4889 int p
= FRAME_CURRENT_GLYPHS (f
)->bufp
[x_mouse_y
];
4890 int tab_width
= XINT (b
->tab_width
);
4891 int ctl_arrow_p
= !NILP (b
->ctl_arrow
);
4893 int mode_line_vpos
= XFASTINT (w
->height
) + XFASTINT (w
->top
) - 1;
4894 int in_mode_line
= 0;
4896 if (! FRAME_CURRENT_GLYPHS (f
)->enable
[x_mouse_y
])
4899 /* Erase previous rectangle. */
4900 if (mouse_track_width
)
4902 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
4903 mouse_track_left
, mouse_track_top
,
4904 mouse_track_width
, 1);
4906 if ((mouse_track_left
== f
->phys_cursor_x
4907 || mouse_track_left
== f
->phys_cursor_x
- 1)
4908 && mouse_track_top
== f
->phys_cursor_y
)
4910 x_display_cursor (f
, 1);
4914 mouse_track_left
= x_mouse_x
;
4915 mouse_track_top
= x_mouse_y
;
4916 mouse_track_width
= 0;
4918 if (mouse_track_left
> len
) /* Past the end of line. */
4921 if (mouse_track_top
== mode_line_vpos
)
4927 if (tab_width
<= 0 || tab_width
> 20) tab_width
= 8;
4931 if (len
== f
->width
&& hp
== len
- 1 && c
!= '\n')
4937 mouse_track_width
= tab_width
- (hp
% tab_width
);
4939 hp
+= mouse_track_width
;
4942 mouse_track_left
= hp
- mouse_track_width
;
4948 mouse_track_width
= -1;
4952 if (ctl_arrow_p
&& (c
< 040 || c
== 0177))
4957 mouse_track_width
= 2;
4962 mouse_track_left
= hp
- mouse_track_width
;
4968 mouse_track_width
= 1;
4975 while (hp
<= x_mouse_x
);
4978 if (mouse_track_width
) /* Over text; use text pointer shape. */
4980 XDefineCursor (FRAME_X_DISPLAY (f
),
4982 f
->output_data
.x
->text_cursor
);
4983 x_rectangle (f
, f
->output_data
.x
->cursor_gc
,
4984 mouse_track_left
, mouse_track_top
,
4985 mouse_track_width
, 1);
4987 else if (in_mode_line
)
4988 XDefineCursor (FRAME_X_DISPLAY (f
),
4990 f
->output_data
.x
->modeline_cursor
);
4992 XDefineCursor (FRAME_X_DISPLAY (f
),
4994 f
->output_data
.x
->nontext_cursor
);
4997 XFlush (FRAME_X_DISPLAY (f
));
5000 obj
= read_char (-1, 0, 0, Qnil
, 0);
5003 while (CONSP (obj
) /* Mouse event */
5004 && EQ (Fcar (Fcdr (Fcdr (obj
))), Qnil
) /* Not scroll bar */
5005 && EQ (Vmouse_depressed
, Qnil
) /* Only motion events */
5006 && EQ (Vmouse_window
, selected_window
) /* In this window */
5009 unread_command_event
= obj
;
5011 if (mouse_track_width
)
5013 x_rectangle (f
, f
->output_data
.x
->reverse_gc
,
5014 mouse_track_left
, mouse_track_top
,
5015 mouse_track_width
, 1);
5016 mouse_track_width
= 0;
5017 if ((mouse_track_left
== f
->phys_cursor_x
5018 || mouse_track_left
- 1 == f
->phys_cursor_x
)
5019 && mouse_track_top
== f
->phys_cursor_y
)
5021 x_display_cursor (f
, 1);
5024 XDefineCursor (FRAME_X_DISPLAY (f
),
5026 f
->output_data
.x
->nontext_cursor
);
5027 XFlush (FRAME_X_DISPLAY (f
));
5037 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5038 on the frame F at position X, Y. */
5040 x_draw_pixmap (f
, x
, y
, image_data
, width
, height
)
5042 int x
, y
, width
, height
;
5047 image
= XCreateBitmapFromData (FRAME_X_DISPLAY (f
),
5048 FRAME_X_WINDOW (f
), image_data
,
5050 XCopyPlane (FRAME_X_DISPLAY (f
), image
, FRAME_X_WINDOW (f
),
5051 f
->output_data
.x
->normal_gc
, 0, 0, width
, height
, x
, y
);
5055 #if 0 /* I'm told these functions are superfluous
5056 given the ability to bind function keys. */
5059 DEFUN ("x-rebind-key", Fx_rebind_key
, Sx_rebind_key
, 3, 3, 0,
5060 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5061 KEYSYM is a string which conforms to the X keysym definitions found\n\
5062 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5063 list of strings specifying modifier keys such as Control_L, which must\n\
5064 also be depressed for NEWSTRING to appear.")
5065 (x_keysym
, modifiers
, newstring
)
5066 register Lisp_Object x_keysym
;
5067 register Lisp_Object modifiers
;
5068 register Lisp_Object newstring
;
5071 register KeySym keysym
;
5072 KeySym modifier_list
[16];
5075 CHECK_STRING (x_keysym
, 1);
5076 CHECK_STRING (newstring
, 3);
5078 keysym
= XStringToKeysym ((char *) XSTRING (x_keysym
)->data
);
5079 if (keysym
== NoSymbol
)
5080 error ("Keysym does not exist");
5082 if (NILP (modifiers
))
5083 XRebindKeysym (x_current_display
, keysym
, modifier_list
, 0,
5084 XSTRING (newstring
)->data
,
5085 STRING_BYTES (XSTRING (newstring
)));
5088 register Lisp_Object rest
, mod
;
5091 for (rest
= modifiers
; !NILP (rest
); rest
= Fcdr (rest
))
5094 error ("Can't have more than 16 modifiers");
5097 CHECK_STRING (mod
, 3);
5098 modifier_list
[i
] = XStringToKeysym ((char *) XSTRING (mod
)->data
);
5100 if (modifier_list
[i
] == NoSymbol
5101 || !(IsModifierKey (modifier_list
[i
])
5102 || ((unsigned)(modifier_list
[i
]) == XK_Mode_switch
)
5103 || ((unsigned)(modifier_list
[i
]) == XK_Num_Lock
)))
5105 if (modifier_list
[i
] == NoSymbol
5106 || !IsModifierKey (modifier_list
[i
]))
5108 error ("Element is not a modifier keysym");
5112 XRebindKeysym (x_current_display
, keysym
, modifier_list
, i
,
5113 XSTRING (newstring
)->data
,
5114 STRING_BYTES (XSTRING (newstring
)));
5120 DEFUN ("x-rebind-keys", Fx_rebind_keys
, Sx_rebind_keys
, 2, 2, 0,
5121 "Rebind KEYCODE to list of strings STRINGS.\n\
5122 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5123 nil as element means don't change.\n\
5124 See the documentation of `x-rebind-key' for more information.")
5126 register Lisp_Object keycode
;
5127 register Lisp_Object strings
;
5129 register Lisp_Object item
;
5130 register unsigned char *rawstring
;
5131 KeySym rawkey
, modifier
[1];
5133 register unsigned i
;
5136 CHECK_NUMBER (keycode
, 1);
5137 CHECK_CONS (strings
, 2);
5138 rawkey
= (KeySym
) ((unsigned) (XINT (keycode
))) & 255;
5139 for (i
= 0; i
<= 15; strings
= Fcdr (strings
), i
++)
5141 item
= Fcar (strings
);
5144 CHECK_STRING (item
, 2);
5145 strsize
= STRING_BYTES (XSTRING (item
));
5146 rawstring
= (unsigned char *) xmalloc (strsize
);
5147 bcopy (XSTRING (item
)->data
, rawstring
, strsize
);
5148 modifier
[1] = 1 << i
;
5149 XRebindKeysym (x_current_display
, rawkey
, modifier
, 1,
5150 rawstring
, strsize
);
5155 #endif /* HAVE_X11 */
5158 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5160 XScreenNumberOfScreen (scr
)
5161 register Screen
*scr
;
5163 register Display
*dpy
;
5164 register Screen
*dpyscr
;
5168 dpyscr
= dpy
->screens
;
5170 for (i
= 0; i
< dpy
->nscreens
; i
++, dpyscr
++)
5176 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5179 select_visual (dpy
, screen
, depth
)
5182 unsigned int *depth
;
5185 XVisualInfo
*vinfo
, vinfo_template
;
5188 v
= DefaultVisualOfScreen (screen
);
5191 vinfo_template
.visualid
= XVisualIDFromVisual (v
);
5193 vinfo_template
.visualid
= v
->visualid
;
5196 vinfo_template
.screen
= XScreenNumberOfScreen (screen
);
5198 vinfo
= XGetVisualInfo (dpy
,
5199 VisualIDMask
| VisualScreenMask
, &vinfo_template
,
5202 fatal ("Can't get proper X visual info");
5204 if ((1 << vinfo
->depth
) == vinfo
->colormap_size
)
5205 *depth
= vinfo
->depth
;
5209 int n
= vinfo
->colormap_size
- 1;
5218 XFree ((char *) vinfo
);
5222 /* Return the X display structure for the display named NAME.
5223 Open a new connection if necessary. */
5225 struct x_display_info
*
5226 x_display_info_for_name (name
)
5230 struct x_display_info
*dpyinfo
;
5232 CHECK_STRING (name
, 0);
5234 if (! EQ (Vwindow_system
, intern ("x")))
5235 error ("Not using X Windows");
5237 for (dpyinfo
= x_display_list
, names
= x_display_name_list
;
5239 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
5242 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
5247 /* Use this general default value to start with. */
5248 Vx_resource_name
= Vinvocation_name
;
5250 validate_x_resource_name ();
5252 dpyinfo
= x_term_init (name
, (unsigned char *)0,
5253 (char *) XSTRING (Vx_resource_name
)->data
);
5256 error ("Cannot connect to X server %s", XSTRING (name
)->data
);
5259 XSETFASTINT (Vwindow_system_version
, 11);
5264 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5265 1, 3, 0, "Open a connection to an X server.\n\
5266 DISPLAY is the name of the display to connect to.\n\
5267 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5268 If the optional third arg MUST-SUCCEED is non-nil,\n\
5269 terminate Emacs if we can't open the connection.")
5270 (display
, xrm_string
, must_succeed
)
5271 Lisp_Object display
, xrm_string
, must_succeed
;
5273 unsigned char *xrm_option
;
5274 struct x_display_info
*dpyinfo
;
5276 CHECK_STRING (display
, 0);
5277 if (! NILP (xrm_string
))
5278 CHECK_STRING (xrm_string
, 1);
5280 if (! EQ (Vwindow_system
, intern ("x")))
5281 error ("Not using X Windows");
5283 if (! NILP (xrm_string
))
5284 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5286 xrm_option
= (unsigned char *) 0;
5288 validate_x_resource_name ();
5290 /* This is what opens the connection and sets x_current_display.
5291 This also initializes many symbols, such as those used for input. */
5292 dpyinfo
= x_term_init (display
, xrm_option
,
5293 (char *) XSTRING (Vx_resource_name
)->data
);
5297 if (!NILP (must_succeed
))
5298 fatal ("Cannot connect to X server %s.\n\
5299 Check the DISPLAY environment variable or use `-d'.\n\
5300 Also use the `xhost' program to verify that it is set to permit\n\
5301 connections from your machine.\n",
5302 XSTRING (display
)->data
);
5304 error ("Cannot connect to X server %s", XSTRING (display
)->data
);
5309 XSETFASTINT (Vwindow_system_version
, 11);
5313 DEFUN ("x-close-connection", Fx_close_connection
,
5314 Sx_close_connection
, 1, 1, 0,
5315 "Close the connection to DISPLAY's X server.\n\
5316 For DISPLAY, specify either a frame or a display name (a string).\n\
5317 If DISPLAY is nil, that stands for the selected frame's display.")
5319 Lisp_Object display
;
5321 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5324 if (dpyinfo
->reference_count
> 0)
5325 error ("Display still has frames on it");
5328 /* Free the fonts in the font table. */
5329 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5330 if (dpyinfo
->font_table
[i
].name
)
5332 xfree (dpyinfo
->font_table
[i
].name
);
5333 /* Don't free the full_name string;
5334 it is always shared with something else. */
5335 XFreeFont (dpyinfo
->display
, dpyinfo
->font_table
[i
].font
);
5338 x_destroy_all_bitmaps (dpyinfo
);
5339 XSetCloseDownMode (dpyinfo
->display
, DestroyAll
);
5341 #ifdef USE_X_TOOLKIT
5342 XtCloseDisplay (dpyinfo
->display
);
5344 XCloseDisplay (dpyinfo
->display
);
5347 x_delete_display (dpyinfo
);
5353 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5354 "Return the list of display names that Emacs has connections to.")
5357 Lisp_Object tail
, result
;
5360 for (tail
= x_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
5361 result
= Fcons (XCAR (XCAR (tail
)), result
);
5366 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5367 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5368 If ON is nil, allow buffering of requests.\n\
5369 Turning on synchronization prohibits the Xlib routines from buffering\n\
5370 requests and seriously degrades performance, but makes debugging much\n\
5372 The optional second argument DISPLAY specifies which display to act on.\n\
5373 DISPLAY should be either a frame or a display name (a string).\n\
5374 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5376 Lisp_Object display
, on
;
5378 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
5380 XSynchronize (dpyinfo
->display
, !EQ (on
, Qnil
));
5385 /* Wait for responses to all X commands issued so far for frame F. */
5392 XSync (FRAME_X_DISPLAY (f
), False
);
5397 /***********************************************************************
5399 ***********************************************************************/
5401 /* Value is the number of elements of vector VECTOR. */
5403 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5405 /* List of supported image types. Use define_image_type to add new
5406 types. Use lookup_image_type to find a type for a given symbol. */
5408 static struct image_type
*image_types
;
5410 /* A list of symbols, one for each supported image type. */
5412 Lisp_Object Vimage_types
;
5414 /* The symbol `image' which is the car of the lists used to represent
5417 extern Lisp_Object Qimage
;
5419 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5425 Lisp_Object QCtype
, QCdata
, QCascent
, QCmargin
, QCrelief
;
5426 extern Lisp_Object QCwidth
, QCheight
, QCforeground
, QCbackground
, QCfile
;
5427 Lisp_Object QCalgorithm
, QCcolor_symbols
, QCheuristic_mask
;
5428 Lisp_Object QCindex
;
5430 /* Other symbols. */
5432 Lisp_Object Qlaplace
;
5434 /* Time in seconds after which images should be removed from the cache
5435 if not displayed. */
5437 Lisp_Object Vimage_cache_eviction_delay
;
5439 /* Function prototypes. */
5441 static void define_image_type
P_ ((struct image_type
*type
));
5442 static struct image_type
*lookup_image_type
P_ ((Lisp_Object symbol
));
5443 static void image_error
P_ ((char *format
, Lisp_Object
, Lisp_Object
));
5444 static void x_laplace
P_ ((struct frame
*, struct image
*));
5445 static int x_build_heuristic_mask
P_ ((struct frame
*, struct image
*,
5449 /* Define a new image type from TYPE. This adds a copy of TYPE to
5450 image_types and adds the symbol *TYPE->type to Vimage_types. */
5453 define_image_type (type
)
5454 struct image_type
*type
;
5456 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5457 The initialized data segment is read-only. */
5458 struct image_type
*p
= (struct image_type
*) xmalloc (sizeof *p
);
5459 bcopy (type
, p
, sizeof *p
);
5460 p
->next
= image_types
;
5462 Vimage_types
= Fcons (*p
->type
, Vimage_types
);
5466 /* Look up image type SYMBOL, and return a pointer to its image_type
5467 structure. Value is null if SYMBOL is not a known image type. */
5469 static INLINE
struct image_type
*
5470 lookup_image_type (symbol
)
5473 struct image_type
*type
;
5475 for (type
= image_types
; type
; type
= type
->next
)
5476 if (EQ (symbol
, *type
->type
))
5483 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5484 valid image specification is a list whose car is the symbol
5485 `image', and whose rest is a property list. The property list must
5486 contain a value for key `:type'. That value must be the name of a
5487 supported image type. The rest of the property list depends on the
5491 valid_image_p (object
)
5496 if (CONSP (object
) && EQ (XCAR (object
), Qimage
))
5498 Lisp_Object symbol
= Fplist_get (XCDR (object
), QCtype
);
5499 struct image_type
*type
= lookup_image_type (symbol
);
5502 valid_p
= type
->valid_p (object
);
5509 /* Log error message with format string FORMAT and argument ARG.
5510 Signaling an error, e.g. when an image cannot be loaded, is not a
5511 good idea because this would interrupt redisplay, and the error
5512 message display would lead to another redisplay. This function
5513 therefore simply displays a message. */
5516 image_error (format
, arg1
, arg2
)
5518 Lisp_Object arg1
, arg2
;
5520 add_to_log (format
, arg1
, arg2
);
5525 /***********************************************************************
5526 Image specifications
5527 ***********************************************************************/
5529 enum image_value_type
5531 IMAGE_DONT_CHECK_VALUE_TYPE
,
5534 IMAGE_POSITIVE_INTEGER_VALUE
,
5535 IMAGE_NON_NEGATIVE_INTEGER_VALUE
,
5536 IMAGE_INTEGER_VALUE
,
5537 IMAGE_FUNCTION_VALUE
,
5542 /* Structure used when parsing image specifications. */
5544 struct image_keyword
5546 /* Name of keyword. */
5549 /* The type of value allowed. */
5550 enum image_value_type type
;
5552 /* Non-zero means key must be present. */
5555 /* Used to recognize duplicate keywords in a property list. */
5558 /* The value that was found. */
5563 static int parse_image_spec
P_ ((Lisp_Object
, struct image_keyword
*,
5565 static Lisp_Object image_spec_value
P_ ((Lisp_Object
, Lisp_Object
, int *));
5568 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5569 has the format (image KEYWORD VALUE ...). One of the keyword/
5570 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5571 image_keywords structures of size NKEYWORDS describing other
5572 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5575 parse_image_spec (spec
, keywords
, nkeywords
, type
)
5577 struct image_keyword
*keywords
;
5584 if (!CONSP (spec
) || !EQ (XCAR (spec
), Qimage
))
5587 plist
= XCDR (spec
);
5588 while (CONSP (plist
))
5590 Lisp_Object key
, value
;
5592 /* First element of a pair must be a symbol. */
5594 plist
= XCDR (plist
);
5598 /* There must follow a value. */
5601 value
= XCAR (plist
);
5602 plist
= XCDR (plist
);
5604 /* Find key in KEYWORDS. Error if not found. */
5605 for (i
= 0; i
< nkeywords
; ++i
)
5606 if (strcmp (keywords
[i
].name
, XSYMBOL (key
)->name
->data
) == 0)
5612 /* Record that we recognized the keyword. If a keywords
5613 was found more than once, it's an error. */
5614 keywords
[i
].value
= value
;
5615 ++keywords
[i
].count
;
5617 if (keywords
[i
].count
> 1)
5620 /* Check type of value against allowed type. */
5621 switch (keywords
[i
].type
)
5623 case IMAGE_STRING_VALUE
:
5624 if (!STRINGP (value
))
5628 case IMAGE_SYMBOL_VALUE
:
5629 if (!SYMBOLP (value
))
5633 case IMAGE_POSITIVE_INTEGER_VALUE
:
5634 if (!INTEGERP (value
) || XINT (value
) <= 0)
5638 case IMAGE_NON_NEGATIVE_INTEGER_VALUE
:
5639 if (!INTEGERP (value
) || XINT (value
) < 0)
5643 case IMAGE_DONT_CHECK_VALUE_TYPE
:
5646 case IMAGE_FUNCTION_VALUE
:
5647 value
= indirect_function (value
);
5649 || COMPILEDP (value
)
5650 || (CONSP (value
) && EQ (XCAR (value
), Qlambda
)))
5654 case IMAGE_NUMBER_VALUE
:
5655 if (!INTEGERP (value
) && !FLOATP (value
))
5659 case IMAGE_INTEGER_VALUE
:
5660 if (!INTEGERP (value
))
5664 case IMAGE_BOOL_VALUE
:
5665 if (!NILP (value
) && !EQ (value
, Qt
))
5674 if (EQ (key
, QCtype
) && !EQ (type
, value
))
5678 /* Check that all mandatory fields are present. */
5679 for (i
= 0; i
< nkeywords
; ++i
)
5680 if (keywords
[i
].mandatory_p
&& keywords
[i
].count
== 0)
5683 return NILP (plist
);
5687 /* Return the value of KEY in image specification SPEC. Value is nil
5688 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5689 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5692 image_spec_value (spec
, key
, found
)
5693 Lisp_Object spec
, key
;
5698 xassert (valid_image_p (spec
));
5700 for (tail
= XCDR (spec
);
5701 CONSP (tail
) && CONSP (XCDR (tail
));
5702 tail
= XCDR (XCDR (tail
)))
5704 if (EQ (XCAR (tail
), key
))
5708 return XCAR (XCDR (tail
));
5720 /***********************************************************************
5721 Image type independent image structures
5722 ***********************************************************************/
5724 static struct image
*make_image
P_ ((Lisp_Object spec
, unsigned hash
));
5725 static void free_image
P_ ((struct frame
*f
, struct image
*img
));
5728 /* Allocate and return a new image structure for image specification
5729 SPEC. SPEC has a hash value of HASH. */
5731 static struct image
*
5732 make_image (spec
, hash
)
5736 struct image
*img
= (struct image
*) xmalloc (sizeof *img
);
5738 xassert (valid_image_p (spec
));
5739 bzero (img
, sizeof *img
);
5740 img
->type
= lookup_image_type (image_spec_value (spec
, QCtype
, NULL
));
5741 xassert (img
->type
!= NULL
);
5743 img
->data
.lisp_val
= Qnil
;
5744 img
->ascent
= DEFAULT_IMAGE_ASCENT
;
5750 /* Free image IMG which was used on frame F, including its resources. */
5759 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5761 /* Remove IMG from the hash table of its cache. */
5763 img
->prev
->next
= img
->next
;
5765 c
->buckets
[img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
] = img
->next
;
5768 img
->next
->prev
= img
->prev
;
5770 c
->images
[img
->id
] = NULL
;
5772 /* Free resources, then free IMG. */
5773 img
->type
->free (f
, img
);
5779 /* Prepare image IMG for display on frame F. Must be called before
5780 drawing an image. */
5783 prepare_image_for_display (f
, img
)
5789 /* We're about to display IMG, so set its timestamp to `now'. */
5791 img
->timestamp
= EMACS_SECS (t
);
5793 /* If IMG doesn't have a pixmap yet, load it now, using the image
5794 type dependent loader function. */
5795 if (img
->pixmap
== 0 && !img
->load_failed_p
)
5796 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
5801 /***********************************************************************
5802 Helper functions for X image types
5803 ***********************************************************************/
5805 static void x_clear_image
P_ ((struct frame
*f
, struct image
*img
));
5806 static unsigned long x_alloc_image_color
P_ ((struct frame
*f
,
5808 Lisp_Object color_name
,
5809 unsigned long dflt
));
5811 /* Free X resources of image IMG which is used on frame F. */
5814 x_clear_image (f
, img
)
5821 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
5828 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
5830 /* If display has an immutable color map, freeing colors is not
5831 necessary and some servers don't allow it. So don't do it. */
5832 if (class != StaticColor
5833 && class != StaticGray
5834 && class != TrueColor
)
5838 cmap
= DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f
)->screen
);
5839 XFreeColors (FRAME_X_DISPLAY (f
), cmap
, img
->colors
,
5844 xfree (img
->colors
);
5851 /* Allocate color COLOR_NAME for image IMG on frame F. If color
5852 cannot be allocated, use DFLT. Add a newly allocated color to
5853 IMG->colors, so that it can be freed again. Value is the pixel
5856 static unsigned long
5857 x_alloc_image_color (f
, img
, color_name
, dflt
)
5860 Lisp_Object color_name
;
5864 unsigned long result
;
5866 xassert (STRINGP (color_name
));
5868 if (x_defined_color (f
, XSTRING (color_name
)->data
, &color
, 1))
5870 /* This isn't called frequently so we get away with simply
5871 reallocating the color vector to the needed size, here. */
5874 (unsigned long *) xrealloc (img
->colors
,
5875 img
->ncolors
* sizeof *img
->colors
);
5876 img
->colors
[img
->ncolors
- 1] = color
.pixel
;
5877 result
= color
.pixel
;
5887 /***********************************************************************
5889 ***********************************************************************/
5891 static void cache_image
P_ ((struct frame
*f
, struct image
*img
));
5894 /* Return a new, initialized image cache that is allocated from the
5895 heap. Call free_image_cache to free an image cache. */
5897 struct image_cache
*
5900 struct image_cache
*c
= (struct image_cache
*) xmalloc (sizeof *c
);
5903 bzero (c
, sizeof *c
);
5905 c
->images
= (struct image
**) xmalloc (c
->size
* sizeof *c
->images
);
5906 size
= IMAGE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5907 c
->buckets
= (struct image
**) xmalloc (size
);
5908 bzero (c
->buckets
, size
);
5913 /* Free image cache of frame F. Be aware that X frames share images
5917 free_image_cache (f
)
5920 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5925 /* Cache should not be referenced by any frame when freed. */
5926 xassert (c
->refcount
== 0);
5928 for (i
= 0; i
< c
->used
; ++i
)
5929 free_image (f
, c
->images
[i
]);
5933 FRAME_X_IMAGE_CACHE (f
) = NULL
;
5938 /* Clear image cache of frame F. FORCE_P non-zero means free all
5939 images. FORCE_P zero means clear only images that haven't been
5940 displayed for some time. Should be called from time to time to
5941 reduce the number of loaded images. If image-eviction-seconds is
5942 non-nil, this frees images in the cache which weren't displayed for
5943 at least that many seconds. */
5946 clear_image_cache (f
, force_p
)
5950 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
5952 if (c
&& INTEGERP (Vimage_cache_eviction_delay
))
5956 int i
, any_freed_p
= 0;
5959 old
= EMACS_SECS (t
) - XFASTINT (Vimage_cache_eviction_delay
);
5961 for (i
= 0; i
< c
->used
; ++i
)
5963 struct image
*img
= c
->images
[i
];
5966 || (img
->timestamp
> old
)))
5968 free_image (f
, img
);
5973 /* We may be clearing the image cache because, for example,
5974 Emacs was iconified for a longer period of time. In that
5975 case, current matrices may still contain references to
5976 images freed above. So, clear these matrices. */
5979 clear_current_matrices (f
);
5980 ++windows_or_buffers_changed
;
5986 DEFUN ("clear-image-cache", Fclear_image_cache
, Sclear_image_cache
,
5988 "Clear the image cache of FRAME.\n\
5989 FRAME nil or omitted means use the selected frame.\n\
5990 FRAME t means clear the image caches of all frames.")
5998 FOR_EACH_FRAME (tail
, frame
)
5999 if (FRAME_X_P (XFRAME (frame
)))
6000 clear_image_cache (XFRAME (frame
), 1);
6003 clear_image_cache (check_x_frame (frame
), 1);
6009 /* Return the id of image with Lisp specification SPEC on frame F.
6010 SPEC must be a valid Lisp image specification (see valid_image_p). */
6013 lookup_image (f
, spec
)
6017 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6021 struct gcpro gcpro1
;
6024 /* F must be a window-system frame, and SPEC must be a valid image
6026 xassert (FRAME_WINDOW_P (f
));
6027 xassert (valid_image_p (spec
));
6031 /* Look up SPEC in the hash table of the image cache. */
6032 hash
= sxhash (spec
, 0);
6033 i
= hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6035 for (img
= c
->buckets
[i
]; img
; img
= img
->next
)
6036 if (img
->hash
== hash
&& !NILP (Fequal (img
->spec
, spec
)))
6039 /* If not found, create a new image and cache it. */
6042 img
= make_image (spec
, hash
);
6043 cache_image (f
, img
);
6044 img
->load_failed_p
= img
->type
->load (f
, img
) == 0;
6045 xassert (!interrupt_input_blocked
);
6047 /* If we can't load the image, and we don't have a width and
6048 height, use some arbitrary width and height so that we can
6049 draw a rectangle for it. */
6050 if (img
->load_failed_p
)
6054 value
= image_spec_value (spec
, QCwidth
, NULL
);
6055 img
->width
= (INTEGERP (value
)
6056 ? XFASTINT (value
) : DEFAULT_IMAGE_WIDTH
);
6057 value
= image_spec_value (spec
, QCheight
, NULL
);
6058 img
->height
= (INTEGERP (value
)
6059 ? XFASTINT (value
) : DEFAULT_IMAGE_HEIGHT
);
6063 /* Handle image type independent image attributes
6064 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6065 Lisp_Object ascent
, margin
, relief
, algorithm
, heuristic_mask
;
6068 ascent
= image_spec_value (spec
, QCascent
, NULL
);
6069 if (INTEGERP (ascent
))
6070 img
->ascent
= XFASTINT (ascent
);
6072 margin
= image_spec_value (spec
, QCmargin
, NULL
);
6073 if (INTEGERP (margin
) && XINT (margin
) >= 0)
6074 img
->margin
= XFASTINT (margin
);
6076 relief
= image_spec_value (spec
, QCrelief
, NULL
);
6077 if (INTEGERP (relief
))
6079 img
->relief
= XINT (relief
);
6080 img
->margin
+= abs (img
->relief
);
6083 /* Should we apply a Laplace edge-detection algorithm? */
6084 algorithm
= image_spec_value (spec
, QCalgorithm
, NULL
);
6085 if (img
->pixmap
&& EQ (algorithm
, Qlaplace
))
6088 /* Should we built a mask heuristically? */
6089 heuristic_mask
= image_spec_value (spec
, QCheuristic_mask
, NULL
);
6090 if (img
->pixmap
&& !img
->mask
&& !NILP (heuristic_mask
))
6091 x_build_heuristic_mask (f
, img
, heuristic_mask
);
6095 /* We're using IMG, so set its timestamp to `now'. */
6096 EMACS_GET_TIME (now
);
6097 img
->timestamp
= EMACS_SECS (now
);
6101 /* Value is the image id. */
6106 /* Cache image IMG in the image cache of frame F. */
6109 cache_image (f
, img
)
6113 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6116 /* Find a free slot in c->images. */
6117 for (i
= 0; i
< c
->used
; ++i
)
6118 if (c
->images
[i
] == NULL
)
6121 /* If no free slot found, maybe enlarge c->images. */
6122 if (i
== c
->used
&& c
->used
== c
->size
)
6125 c
->images
= (struct image
**) xrealloc (c
->images
,
6126 c
->size
* sizeof *c
->images
);
6129 /* Add IMG to c->images, and assign IMG an id. */
6135 /* Add IMG to the cache's hash table. */
6136 i
= img
->hash
% IMAGE_CACHE_BUCKETS_SIZE
;
6137 img
->next
= c
->buckets
[i
];
6139 img
->next
->prev
= img
;
6141 c
->buckets
[i
] = img
;
6145 /* Call FN on every image in the image cache of frame F. Used to mark
6146 Lisp Objects in the image cache. */
6149 forall_images_in_image_cache (f
, fn
)
6151 void (*fn
) P_ ((struct image
*img
));
6153 if (FRAME_LIVE_P (f
) && FRAME_X_P (f
))
6155 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
6159 for (i
= 0; i
< c
->used
; ++i
)
6168 /***********************************************************************
6170 ***********************************************************************/
6172 static int x_create_x_image_and_pixmap
P_ ((struct frame
*, int, int, int,
6173 XImage
**, Pixmap
*));
6174 static void x_destroy_x_image
P_ ((XImage
*));
6175 static void x_put_x_image
P_ ((struct frame
*, XImage
*, Pixmap
, int, int));
6178 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6179 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6180 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6181 via xmalloc. Print error messages via image_error if an error
6182 occurs. Value is non-zero if successful. */
6185 x_create_x_image_and_pixmap (f
, width
, height
, depth
, ximg
, pixmap
)
6187 int width
, height
, depth
;
6191 Display
*display
= FRAME_X_DISPLAY (f
);
6192 Screen
*screen
= FRAME_X_SCREEN (f
);
6193 Window window
= FRAME_X_WINDOW (f
);
6195 xassert (interrupt_input_blocked
);
6198 depth
= DefaultDepthOfScreen (screen
);
6199 *ximg
= XCreateImage (display
, DefaultVisualOfScreen (screen
),
6200 depth
, ZPixmap
, 0, NULL
, width
, height
,
6201 depth
> 16 ? 32 : depth
> 8 ? 16 : 8, 0);
6204 image_error ("Unable to allocate X image", Qnil
, Qnil
);
6208 /* Allocate image raster. */
6209 (*ximg
)->data
= (char *) xmalloc ((*ximg
)->bytes_per_line
* height
);
6211 /* Allocate a pixmap of the same size. */
6212 *pixmap
= XCreatePixmap (display
, window
, width
, height
, depth
);
6215 x_destroy_x_image (*ximg
);
6217 image_error ("Unable to create X pixmap", Qnil
, Qnil
);
6225 /* Destroy XImage XIMG. Free XIMG->data. */
6228 x_destroy_x_image (ximg
)
6231 xassert (interrupt_input_blocked
);
6236 XDestroyImage (ximg
);
6241 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6242 are width and height of both the image and pixmap. */
6245 x_put_x_image (f
, ximg
, pixmap
, width
, height
)
6252 xassert (interrupt_input_blocked
);
6253 gc
= XCreateGC (FRAME_X_DISPLAY (f
), pixmap
, 0, NULL
);
6254 XPutImage (FRAME_X_DISPLAY (f
), pixmap
, gc
, ximg
, 0, 0, 0, 0, width
, height
);
6255 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
6260 /***********************************************************************
6262 ***********************************************************************/
6264 static Lisp_Object x_find_image_file
P_ ((Lisp_Object
));
6266 /* Find image file FILE. Look in data-directory, then
6267 x-bitmap-file-path. Value is the full name of the file found, or
6268 nil if not found. */
6271 x_find_image_file (file
)
6274 Lisp_Object file_found
, search_path
;
6275 struct gcpro gcpro1
, gcpro2
;
6279 search_path
= Fcons (Vdata_directory
, Vx_bitmap_file_path
);
6280 GCPRO2 (file_found
, search_path
);
6282 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6283 fd
= openp (search_path
, file
, "", &file_found
, 0);
6296 /***********************************************************************
6298 ***********************************************************************/
6300 static int xbm_load
P_ ((struct frame
*f
, struct image
*img
));
6301 static int xbm_load_image_from_file
P_ ((struct frame
*f
, struct image
*img
,
6303 static int xbm_image_p
P_ ((Lisp_Object object
));
6304 static int xbm_read_bitmap_file_data
P_ ((char *, int *, int *,
6308 /* Indices of image specification fields in xbm_format, below. */
6310 enum xbm_keyword_index
6327 /* Vector of image_keyword structures describing the format
6328 of valid XBM image specifications. */
6330 static struct image_keyword xbm_format
[XBM_LAST
] =
6332 {":type", IMAGE_SYMBOL_VALUE
, 1},
6333 {":file", IMAGE_STRING_VALUE
, 0},
6334 {":width", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6335 {":height", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6336 {":data", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6337 {":foreground", IMAGE_STRING_VALUE
, 0},
6338 {":background", IMAGE_STRING_VALUE
, 0},
6339 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6340 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6341 {":relief", IMAGE_INTEGER_VALUE
, 0},
6342 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6343 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6346 /* Structure describing the image type XBM. */
6348 static struct image_type xbm_type
=
6357 /* Tokens returned from xbm_scan. */
6366 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6367 A valid specification is a list starting with the symbol `image'
6368 The rest of the list is a property list which must contain an
6371 If the specification specifies a file to load, it must contain
6372 an entry `:file FILENAME' where FILENAME is a string.
6374 If the specification is for a bitmap loaded from memory it must
6375 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6376 WIDTH and HEIGHT are integers > 0. DATA may be:
6378 1. a string large enough to hold the bitmap data, i.e. it must
6379 have a size >= (WIDTH + 7) / 8 * HEIGHT
6381 2. a bool-vector of size >= WIDTH * HEIGHT
6383 3. a vector of strings or bool-vectors, one for each line of the
6386 Both the file and data forms may contain the additional entries
6387 `:background COLOR' and `:foreground COLOR'. If not present,
6388 foreground and background of the frame on which the image is
6389 displayed, is used. */
6392 xbm_image_p (object
)
6395 struct image_keyword kw
[XBM_LAST
];
6397 bcopy (xbm_format
, kw
, sizeof kw
);
6398 if (!parse_image_spec (object
, kw
, XBM_LAST
, Qxbm
))
6401 xassert (EQ (kw
[XBM_TYPE
].value
, Qxbm
));
6403 if (kw
[XBM_FILE
].count
)
6405 if (kw
[XBM_WIDTH
].count
|| kw
[XBM_HEIGHT
].count
|| kw
[XBM_DATA
].count
)
6413 /* Entries for `:width', `:height' and `:data' must be present. */
6414 if (!kw
[XBM_WIDTH
].count
6415 || !kw
[XBM_HEIGHT
].count
6416 || !kw
[XBM_DATA
].count
)
6419 data
= kw
[XBM_DATA
].value
;
6420 width
= XFASTINT (kw
[XBM_WIDTH
].value
);
6421 height
= XFASTINT (kw
[XBM_HEIGHT
].value
);
6423 /* Check type of data, and width and height against contents of
6429 /* Number of elements of the vector must be >= height. */
6430 if (XVECTOR (data
)->size
< height
)
6433 /* Each string or bool-vector in data must be large enough
6434 for one line of the image. */
6435 for (i
= 0; i
< height
; ++i
)
6437 Lisp_Object elt
= XVECTOR (data
)->contents
[i
];
6441 if (XSTRING (elt
)->size
6442 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
)
6445 else if (BOOL_VECTOR_P (elt
))
6447 if (XBOOL_VECTOR (elt
)->size
< width
)
6454 else if (STRINGP (data
))
6456 if (XSTRING (data
)->size
6457 < (width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
* height
)
6460 else if (BOOL_VECTOR_P (data
))
6462 if (XBOOL_VECTOR (data
)->size
< width
* height
)
6469 /* Baseline must be a value between 0 and 100 (a percentage). */
6470 if (kw
[XBM_ASCENT
].count
6471 && XFASTINT (kw
[XBM_ASCENT
].value
) > 100)
6478 /* Scan a bitmap file. FP is the stream to read from. Value is
6479 either an enumerator from enum xbm_token, or a character for a
6480 single-character token, or 0 at end of file. If scanning an
6481 identifier, store the lexeme of the identifier in SVAL. If
6482 scanning a number, store its value in *IVAL. */
6485 xbm_scan (fp
, sval
, ival
)
6492 /* Skip white space. */
6493 while ((c
= fgetc (fp
)) != EOF
&& isspace (c
))
6498 else if (isdigit (c
))
6500 int value
= 0, digit
;
6505 if (c
== 'x' || c
== 'X')
6507 while ((c
= fgetc (fp
)) != EOF
)
6511 else if (c
>= 'a' && c
<= 'f')
6512 digit
= c
- 'a' + 10;
6513 else if (c
>= 'A' && c
<= 'F')
6514 digit
= c
- 'A' + 10;
6517 value
= 16 * value
+ digit
;
6520 else if (isdigit (c
))
6523 while ((c
= fgetc (fp
)) != EOF
6525 value
= 8 * value
+ c
- '0';
6531 while ((c
= fgetc (fp
)) != EOF
6533 value
= 10 * value
+ c
- '0';
6541 else if (isalpha (c
) || c
== '_')
6544 while ((c
= fgetc (fp
)) != EOF
6545 && (isalnum (c
) || c
== '_'))
6557 /* Replacement for XReadBitmapFileData which isn't available under old
6558 X versions. FILE is the name of the bitmap file to read. Set
6559 *WIDTH and *HEIGHT to the width and height of the image. Return in
6560 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6564 xbm_read_bitmap_file_data (file
, width
, height
, data
)
6566 int *width
, *height
;
6567 unsigned char **data
;
6570 char buffer
[BUFSIZ
];
6573 int bytes_per_line
, i
, nbytes
;
6579 LA1 = xbm_scan (fp, buffer, &value)
6581 #define expect(TOKEN) \
6582 if (LA1 != (TOKEN)) \
6587 #define expect_ident(IDENT) \
6588 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6593 fp
= fopen (file
, "r");
6597 *width
= *height
= -1;
6599 LA1
= xbm_scan (fp
, buffer
, &value
);
6601 /* Parse defines for width, height and hot-spots. */
6605 expect_ident ("define");
6606 expect (XBM_TK_IDENT
);
6608 if (LA1
== XBM_TK_NUMBER
);
6610 char *p
= strrchr (buffer
, '_');
6611 p
= p
? p
+ 1 : buffer
;
6612 if (strcmp (p
, "width") == 0)
6614 else if (strcmp (p
, "height") == 0)
6617 expect (XBM_TK_NUMBER
);
6620 if (*width
< 0 || *height
< 0)
6623 /* Parse bits. Must start with `static'. */
6624 expect_ident ("static");
6625 if (LA1
== XBM_TK_IDENT
)
6627 if (strcmp (buffer
, "unsigned") == 0)
6630 expect_ident ("char");
6632 else if (strcmp (buffer
, "short") == 0)
6636 if (*width
% 16 && *width
% 16 < 9)
6639 else if (strcmp (buffer
, "char") == 0)
6647 expect (XBM_TK_IDENT
);
6653 bytes_per_line
= (*width
+ 7) / 8 + padding_p
;
6654 nbytes
= bytes_per_line
* *height
;
6655 p
= *data
= (char *) xmalloc (nbytes
);
6660 for (i
= 0; i
< nbytes
; i
+= 2)
6663 expect (XBM_TK_NUMBER
);
6666 if (!padding_p
|| ((i
+ 2) % bytes_per_line
))
6669 if (LA1
== ',' || LA1
== '}')
6677 for (i
= 0; i
< nbytes
; ++i
)
6680 expect (XBM_TK_NUMBER
);
6684 if (LA1
== ',' || LA1
== '}')
6710 /* Load XBM image IMG which will be displayed on frame F from file
6711 SPECIFIED_FILE. Value is non-zero if successful. */
6714 xbm_load_image_from_file (f
, img
, specified_file
)
6717 Lisp_Object specified_file
;
6720 unsigned char *data
;
6723 struct gcpro gcpro1
;
6725 xassert (STRINGP (specified_file
));
6729 file
= x_find_image_file (specified_file
);
6730 if (!STRINGP (file
))
6732 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
6737 rc
= xbm_read_bitmap_file_data (XSTRING (file
)->data
, &img
->width
,
6738 &img
->height
, &data
);
6741 int depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6742 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6743 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6746 xassert (img
->width
> 0 && img
->height
> 0);
6748 /* Get foreground and background colors, maybe allocate colors. */
6749 value
= image_spec_value (img
->spec
, QCforeground
, NULL
);
6751 foreground
= x_alloc_image_color (f
, img
, value
, foreground
);
6753 value
= image_spec_value (img
->spec
, QCbackground
, NULL
);
6755 background
= x_alloc_image_color (f
, img
, value
, background
);
6759 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6762 img
->width
, img
->height
,
6763 foreground
, background
,
6767 if (img
->pixmap
== 0)
6769 x_clear_image (f
, img
);
6770 image_error ("Unable to create X pixmap for `%s'", file
, Qnil
);
6778 image_error ("Error loading XBM image `%s'", img
->spec
, Qnil
);
6785 /* Fill image IMG which is used on frame F with pixmap data. Value is
6786 non-zero if successful. */
6794 Lisp_Object file_name
;
6796 xassert (xbm_image_p (img
->spec
));
6798 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6799 file_name
= image_spec_value (img
->spec
, QCfile
, NULL
);
6800 if (STRINGP (file_name
))
6801 success_p
= xbm_load_image_from_file (f
, img
, file_name
);
6804 struct image_keyword fmt
[XBM_LAST
];
6807 unsigned long foreground
= FRAME_FOREGROUND_PIXEL (f
);
6808 unsigned long background
= FRAME_BACKGROUND_PIXEL (f
);
6812 /* Parse the list specification. */
6813 bcopy (xbm_format
, fmt
, sizeof fmt
);
6814 parsed_p
= parse_image_spec (img
->spec
, fmt
, XBM_LAST
, Qxbm
);
6817 /* Get specified width, and height. */
6818 img
->width
= XFASTINT (fmt
[XBM_WIDTH
].value
);
6819 img
->height
= XFASTINT (fmt
[XBM_HEIGHT
].value
);
6820 xassert (img
->width
> 0 && img
->height
> 0);
6824 if (fmt
[XBM_ASCENT
].count
)
6825 img
->ascent
= XFASTINT (fmt
[XBM_ASCENT
].value
);
6827 /* Get foreground and background colors, maybe allocate colors. */
6828 if (fmt
[XBM_FOREGROUND
].count
)
6829 foreground
= x_alloc_image_color (f
, img
, fmt
[XBM_FOREGROUND
].value
,
6831 if (fmt
[XBM_BACKGROUND
].count
)
6832 background
= x_alloc_image_color (f
, img
, fmt
[XBM_BACKGROUND
].value
,
6835 /* Set bits to the bitmap image data. */
6836 data
= fmt
[XBM_DATA
].value
;
6841 int nbytes
= (img
->width
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
6843 p
= bits
= (char *) alloca (nbytes
* img
->height
);
6844 for (i
= 0; i
< img
->height
; ++i
, p
+= nbytes
)
6846 Lisp_Object line
= XVECTOR (data
)->contents
[i
];
6848 bcopy (XSTRING (line
)->data
, p
, nbytes
);
6850 bcopy (XBOOL_VECTOR (line
)->data
, p
, nbytes
);
6853 else if (STRINGP (data
))
6854 bits
= XSTRING (data
)->data
;
6856 bits
= XBOOL_VECTOR (data
)->data
;
6858 /* Create the pixmap. */
6859 depth
= DefaultDepthOfScreen (FRAME_X_SCREEN (f
));
6861 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f
),
6864 img
->width
, img
->height
,
6865 foreground
, background
,
6871 image_error ("Unable to create pixmap for XBM image `%s'",
6873 x_clear_image (f
, img
);
6884 /***********************************************************************
6886 ***********************************************************************/
6890 static int xpm_image_p
P_ ((Lisp_Object object
));
6891 static int xpm_load
P_ ((struct frame
*f
, struct image
*img
));
6892 static int xpm_valid_color_symbols_p
P_ ((Lisp_Object
));
6894 #include "X11/xpm.h"
6896 /* The symbol `xpm' identifying XPM-format images. */
6900 /* Indices of image specification fields in xpm_format, below. */
6902 enum xpm_keyword_index
6916 /* Vector of image_keyword structures describing the format
6917 of valid XPM image specifications. */
6919 static struct image_keyword xpm_format
[XPM_LAST
] =
6921 {":type", IMAGE_SYMBOL_VALUE
, 1},
6922 {":file", IMAGE_STRING_VALUE
, 0},
6923 {":data", IMAGE_STRING_VALUE
, 0},
6924 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
6925 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
6926 {":relief", IMAGE_INTEGER_VALUE
, 0},
6927 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6928 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
6929 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
6932 /* Structure describing the image type XBM. */
6934 static struct image_type xpm_type
=
6944 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6945 for XPM images. Such a list must consist of conses whose car and
6949 xpm_valid_color_symbols_p (color_symbols
)
6950 Lisp_Object color_symbols
;
6952 while (CONSP (color_symbols
))
6954 Lisp_Object sym
= XCAR (color_symbols
);
6956 || !STRINGP (XCAR (sym
))
6957 || !STRINGP (XCDR (sym
)))
6959 color_symbols
= XCDR (color_symbols
);
6962 return NILP (color_symbols
);
6966 /* Value is non-zero if OBJECT is a valid XPM image specification. */
6969 xpm_image_p (object
)
6972 struct image_keyword fmt
[XPM_LAST
];
6973 bcopy (xpm_format
, fmt
, sizeof fmt
);
6974 return (parse_image_spec (object
, fmt
, XPM_LAST
, Qxpm
)
6975 /* Either `:file' or `:data' must be present. */
6976 && fmt
[XPM_FILE
].count
+ fmt
[XPM_DATA
].count
== 1
6977 /* Either no `:color-symbols' or it's a list of conses
6978 whose car and cdr are strings. */
6979 && (fmt
[XPM_COLOR_SYMBOLS
].count
== 0
6980 || xpm_valid_color_symbols_p (fmt
[XPM_COLOR_SYMBOLS
].value
))
6981 && (fmt
[XPM_ASCENT
].count
== 0
6982 || XFASTINT (fmt
[XPM_ASCENT
].value
) < 100));
6986 /* Load image IMG which will be displayed on frame F. Value is
6987 non-zero if successful. */
6995 XpmAttributes attrs
;
6996 Lisp_Object specified_file
, color_symbols
;
6998 /* Configure the XPM lib. Use the visual of frame F. Allocate
6999 close colors. Return colors allocated. */
7000 bzero (&attrs
, sizeof attrs
);
7001 attrs
.visual
= FRAME_X_DISPLAY_INFO (f
)->visual
;
7002 attrs
.valuemask
|= XpmVisual
;
7003 attrs
.valuemask
|= XpmReturnAllocPixels
;
7004 #ifdef XpmAllocCloseColors
7005 attrs
.alloc_close_colors
= 1;
7006 attrs
.valuemask
|= XpmAllocCloseColors
;
7008 attrs
.closeness
= 600;
7009 attrs
.valuemask
|= XpmCloseness
;
7012 /* If image specification contains symbolic color definitions, add
7013 these to `attrs'. */
7014 color_symbols
= image_spec_value (img
->spec
, QCcolor_symbols
, NULL
);
7015 if (CONSP (color_symbols
))
7018 XpmColorSymbol
*xpm_syms
;
7021 attrs
.valuemask
|= XpmColorSymbols
;
7023 /* Count number of symbols. */
7024 attrs
.numsymbols
= 0;
7025 for (tail
= color_symbols
; CONSP (tail
); tail
= XCDR (tail
))
7028 /* Allocate an XpmColorSymbol array. */
7029 size
= attrs
.numsymbols
* sizeof *xpm_syms
;
7030 xpm_syms
= (XpmColorSymbol
*) alloca (size
);
7031 bzero (xpm_syms
, size
);
7032 attrs
.colorsymbols
= xpm_syms
;
7034 /* Fill the color symbol array. */
7035 for (tail
= color_symbols
, i
= 0;
7037 ++i
, tail
= XCDR (tail
))
7039 Lisp_Object name
= XCAR (XCAR (tail
));
7040 Lisp_Object color
= XCDR (XCAR (tail
));
7041 xpm_syms
[i
].name
= (char *) alloca (XSTRING (name
)->size
+ 1);
7042 strcpy (xpm_syms
[i
].name
, XSTRING (name
)->data
);
7043 xpm_syms
[i
].value
= (char *) alloca (XSTRING (color
)->size
+ 1);
7044 strcpy (xpm_syms
[i
].value
, XSTRING (color
)->data
);
7048 /* Create a pixmap for the image, either from a file, or from a
7049 string buffer containing data in the same format as an XPM file. */
7051 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7052 if (STRINGP (specified_file
))
7054 Lisp_Object file
= x_find_image_file (specified_file
);
7055 if (!STRINGP (file
))
7057 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7062 rc
= XpmReadFileToPixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7063 XSTRING (file
)->data
, &img
->pixmap
, &img
->mask
,
7068 Lisp_Object buffer
= image_spec_value (img
->spec
, QCdata
, NULL
);
7069 rc
= XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
7070 XSTRING (buffer
)->data
,
7071 &img
->pixmap
, &img
->mask
,
7076 if (rc
== XpmSuccess
)
7078 /* Remember allocated colors. */
7079 img
->ncolors
= attrs
.nalloc_pixels
;
7080 img
->colors
= (unsigned long *) xmalloc (img
->ncolors
7081 * sizeof *img
->colors
);
7082 for (i
= 0; i
< attrs
.nalloc_pixels
; ++i
)
7083 img
->colors
[i
] = attrs
.alloc_pixels
[i
];
7085 img
->width
= attrs
.width
;
7086 img
->height
= attrs
.height
;
7087 xassert (img
->width
> 0 && img
->height
> 0);
7089 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7091 XpmFreeAttributes (&attrs
);
7099 image_error ("Error opening XPM file (%s)", img
->spec
, Qnil
);
7102 case XpmFileInvalid
:
7103 image_error ("Invalid XPM file (%s)", img
->spec
, Qnil
);
7107 image_error ("Out of memory (%s)", img
->spec
, Qnil
);
7110 case XpmColorFailed
:
7111 image_error ("Color allocation error (%s)", img
->spec
, Qnil
);
7115 image_error ("Unknown error (%s)", img
->spec
, Qnil
);
7120 return rc
== XpmSuccess
;
7123 #endif /* HAVE_XPM != 0 */
7126 /***********************************************************************
7128 ***********************************************************************/
7130 /* An entry in the color table mapping an RGB color to a pixel color. */
7135 unsigned long pixel
;
7137 /* Next in color table collision list. */
7138 struct ct_color
*next
;
7141 /* The bucket vector size to use. Must be prime. */
7145 /* Value is a hash of the RGB color given by R, G, and B. */
7147 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7149 /* The color hash table. */
7151 struct ct_color
**ct_table
;
7153 /* Number of entries in the color table. */
7155 int ct_colors_allocated
;
7157 /* Function prototypes. */
7159 static void init_color_table
P_ ((void));
7160 static void free_color_table
P_ ((void));
7161 static unsigned long *colors_in_color_table
P_ ((int *n
));
7162 static unsigned long lookup_rgb_color
P_ ((struct frame
*f
, int r
, int g
, int b
));
7163 static unsigned long lookup_pixel_color
P_ ((struct frame
*f
, unsigned long p
));
7166 /* Initialize the color table. */
7171 int size
= CT_SIZE
* sizeof (*ct_table
);
7172 ct_table
= (struct ct_color
**) xmalloc (size
);
7173 bzero (ct_table
, size
);
7174 ct_colors_allocated
= 0;
7178 /* Free memory associated with the color table. */
7184 struct ct_color
*p
, *next
;
7186 for (i
= 0; i
< CT_SIZE
; ++i
)
7187 for (p
= ct_table
[i
]; p
; p
= next
)
7198 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7199 entry for that color already is in the color table, return the
7200 pixel color of that entry. Otherwise, allocate a new color for R,
7201 G, B, and make an entry in the color table. */
7203 static unsigned long
7204 lookup_rgb_color (f
, r
, g
, b
)
7208 unsigned hash
= CT_HASH_RGB (r
, g
, b
);
7209 int i
= hash
% CT_SIZE
;
7212 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7213 if (p
->r
== r
&& p
->g
== g
&& p
->b
== b
)
7227 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7228 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7233 ++ct_colors_allocated
;
7235 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7239 p
->pixel
= color
.pixel
;
7240 p
->next
= ct_table
[i
];
7244 return FRAME_FOREGROUND_PIXEL (f
);
7251 /* Look up pixel color PIXEL which is used on frame F in the color
7252 table. If not already present, allocate it. Value is PIXEL. */
7254 static unsigned long
7255 lookup_pixel_color (f
, pixel
)
7257 unsigned long pixel
;
7259 int i
= pixel
% CT_SIZE
;
7262 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7263 if (p
->pixel
== pixel
)
7274 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7275 color
.pixel
= pixel
;
7276 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
7277 rc
= x_alloc_nearest_color (f
, cmap
, &color
);
7282 ++ct_colors_allocated
;
7284 p
= (struct ct_color
*) xmalloc (sizeof *p
);
7289 p
->next
= ct_table
[i
];
7293 return FRAME_FOREGROUND_PIXEL (f
);
7300 /* Value is a vector of all pixel colors contained in the color table,
7301 allocated via xmalloc. Set *N to the number of colors. */
7303 static unsigned long *
7304 colors_in_color_table (n
)
7309 unsigned long *colors
;
7311 if (ct_colors_allocated
== 0)
7318 colors
= (unsigned long *) xmalloc (ct_colors_allocated
7320 *n
= ct_colors_allocated
;
7322 for (i
= j
= 0; i
< CT_SIZE
; ++i
)
7323 for (p
= ct_table
[i
]; p
; p
= p
->next
)
7324 colors
[j
++] = p
->pixel
;
7332 /***********************************************************************
7334 ***********************************************************************/
7336 static void x_laplace_write_row
P_ ((struct frame
*, long *,
7337 int, XImage
*, int));
7338 static void x_laplace_read_row
P_ ((struct frame
*, Colormap
,
7339 XColor
*, int, XImage
*, int));
7342 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7343 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7344 the width of one row in the image. */
7347 x_laplace_read_row (f
, cmap
, colors
, width
, ximg
, y
)
7357 for (x
= 0; x
< width
; ++x
)
7358 colors
[x
].pixel
= XGetPixel (ximg
, x
, y
);
7360 XQueryColors (FRAME_X_DISPLAY (f
), cmap
, colors
, width
);
7364 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7365 containing the pixel colors to write. F is the frame we are
7369 x_laplace_write_row (f
, pixels
, width
, ximg
, y
)
7378 for (x
= 0; x
< width
; ++x
)
7379 XPutPixel (ximg
, x
, y
, pixels
[x
]);
7383 /* Transform image IMG which is used on frame F with a Laplace
7384 edge-detection algorithm. The result is an image that can be used
7385 to draw disabled buttons, for example. */
7392 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7393 XImage
*ximg
, *oimg
;
7399 int in_y
, out_y
, rc
;
7404 /* Get the X image IMG->pixmap. */
7405 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
7406 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
7408 /* Allocate 3 input rows, and one output row of colors. */
7409 for (i
= 0; i
< 3; ++i
)
7410 in
[i
] = (XColor
*) alloca (img
->width
* sizeof (XColor
));
7411 out
= (long *) alloca (img
->width
* sizeof (long));
7413 /* Create an X image for output. */
7414 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 0,
7417 /* Fill first two rows. */
7418 x_laplace_read_row (f
, cmap
, in
[0], img
->width
, ximg
, 0);
7419 x_laplace_read_row (f
, cmap
, in
[1], img
->width
, ximg
, 1);
7422 /* Write first row, all zeros. */
7423 init_color_table ();
7424 pixel
= lookup_rgb_color (f
, 0, 0, 0);
7425 for (x
= 0; x
< img
->width
; ++x
)
7427 x_laplace_write_row (f
, out
, img
->width
, oimg
, 0);
7430 for (y
= 2; y
< img
->height
; ++y
)
7433 int rowb
= (y
+ 2) % 3;
7435 x_laplace_read_row (f
, cmap
, in
[rowa
], img
->width
, ximg
, in_y
++);
7437 for (x
= 0; x
< img
->width
- 2; ++x
)
7439 int r
= in
[rowa
][x
].red
+ mv2
- in
[rowb
][x
+ 2].red
;
7440 int g
= in
[rowa
][x
].green
+ mv2
- in
[rowb
][x
+ 2].green
;
7441 int b
= in
[rowa
][x
].blue
+ mv2
- in
[rowb
][x
+ 2].blue
;
7443 out
[x
+ 1] = lookup_rgb_color (f
, r
& 0xffff, g
& 0xffff,
7447 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
++);
7450 /* Write last line, all zeros. */
7451 for (x
= 0; x
< img
->width
; ++x
)
7453 x_laplace_write_row (f
, out
, img
->width
, oimg
, out_y
);
7455 /* Free the input image, and free resources of IMG. */
7456 XDestroyImage (ximg
);
7457 x_clear_image (f
, img
);
7459 /* Put the output image into pixmap, and destroy it. */
7460 x_put_x_image (f
, oimg
, pixmap
, img
->width
, img
->height
);
7461 x_destroy_x_image (oimg
);
7463 /* Remember new pixmap and colors in IMG. */
7464 img
->pixmap
= pixmap
;
7465 img
->colors
= colors_in_color_table (&img
->ncolors
);
7466 free_color_table ();
7472 /* Build a mask for image IMG which is used on frame F. FILE is the
7473 name of an image file, for error messages. HOW determines how to
7474 determine the background color of IMG. If it is a list '(R G B)',
7475 with R, G, and B being integers >= 0, take that as the color of the
7476 background. Otherwise, determine the background color of IMG
7477 heuristically. Value is non-zero if successful. */
7480 x_build_heuristic_mask (f
, img
, how
)
7485 Display
*dpy
= FRAME_X_DISPLAY (f
);
7486 XImage
*ximg
, *mask_img
;
7487 int x
, y
, rc
, look_at_corners_p
;
7492 /* Create an image and pixmap serving as mask. */
7493 rc
= x_create_x_image_and_pixmap (f
, img
->width
, img
->height
, 1,
7494 &mask_img
, &img
->mask
);
7501 /* Get the X image of IMG->pixmap. */
7502 ximg
= XGetImage (dpy
, img
->pixmap
, 0, 0, img
->width
, img
->height
,
7505 /* Determine the background color of ximg. If HOW is `(R G B)'
7506 take that as color. Otherwise, try to determine the color
7508 look_at_corners_p
= 1;
7516 && NATNUMP (XCAR (how
)))
7518 rgb
[i
] = XFASTINT (XCAR (how
)) & 0xffff;
7522 if (i
== 3 && NILP (how
))
7524 char color_name
[30];
7525 XColor exact
, color
;
7528 sprintf (color_name
, "#%04x%04x%04x", rgb
[0], rgb
[1], rgb
[2]);
7530 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
7531 if (XLookupColor (dpy
, cmap
, color_name
, &exact
, &color
))
7534 look_at_corners_p
= 0;
7539 if (look_at_corners_p
)
7541 unsigned long corners
[4];
7544 /* Get the colors at the corners of ximg. */
7545 corners
[0] = XGetPixel (ximg
, 0, 0);
7546 corners
[1] = XGetPixel (ximg
, img
->width
- 1, 0);
7547 corners
[2] = XGetPixel (ximg
, img
->width
- 1, img
->height
- 1);
7548 corners
[3] = XGetPixel (ximg
, 0, img
->height
- 1);
7550 /* Choose the most frequently found color as background. */
7551 for (i
= best_count
= 0; i
< 4; ++i
)
7555 for (j
= n
= 0; j
< 4; ++j
)
7556 if (corners
[i
] == corners
[j
])
7560 bg
= corners
[i
], best_count
= n
;
7564 /* Set all bits in mask_img to 1 whose color in ximg is different
7565 from the background color bg. */
7566 for (y
= 0; y
< img
->height
; ++y
)
7567 for (x
= 0; x
< img
->width
; ++x
)
7568 XPutPixel (mask_img
, x
, y
, XGetPixel (ximg
, x
, y
) != bg
);
7570 /* Put mask_img into img->mask. */
7571 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
7572 x_destroy_x_image (mask_img
);
7573 XDestroyImage (ximg
);
7581 /***********************************************************************
7582 PBM (mono, gray, color)
7583 ***********************************************************************/
7585 static int pbm_image_p
P_ ((Lisp_Object object
));
7586 static int pbm_load
P_ ((struct frame
*f
, struct image
*img
));
7587 static int pbm_scan_number
P_ ((unsigned char **, unsigned char *));
7589 /* The symbol `pbm' identifying images of this type. */
7593 /* Indices of image specification fields in gs_format, below. */
7595 enum pbm_keyword_index
7608 /* Vector of image_keyword structures describing the format
7609 of valid user-defined image specifications. */
7611 static struct image_keyword pbm_format
[PBM_LAST
] =
7613 {":type", IMAGE_SYMBOL_VALUE
, 1},
7614 {":file", IMAGE_STRING_VALUE
, 0},
7615 {":data", IMAGE_STRING_VALUE
, 0},
7616 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7617 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7618 {":relief", IMAGE_INTEGER_VALUE
, 0},
7619 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7620 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7623 /* Structure describing the image type `pbm'. */
7625 static struct image_type pbm_type
=
7635 /* Return non-zero if OBJECT is a valid PBM image specification. */
7638 pbm_image_p (object
)
7641 struct image_keyword fmt
[PBM_LAST
];
7643 bcopy (pbm_format
, fmt
, sizeof fmt
);
7645 if (!parse_image_spec (object
, fmt
, PBM_LAST
, Qpbm
)
7646 || (fmt
[PBM_ASCENT
].count
7647 && XFASTINT (fmt
[PBM_ASCENT
].value
) > 100))
7650 /* Must specify either :data or :file. */
7651 return fmt
[PBM_DATA
].count
+ fmt
[PBM_FILE
].count
== 1;
7655 /* Scan a decimal number from *S and return it. Advance *S while
7656 reading the number. END is the end of the string. Value is -1 at
7660 pbm_scan_number (s
, end
)
7661 unsigned char **s
, *end
;
7667 /* Skip white-space. */
7668 while (*s
< end
&& (c
= *(*s
)++, isspace (c
)))
7673 /* Skip comment to end of line. */
7674 while (*s
< end
&& (c
= *(*s
)++, c
!= '\n'))
7677 else if (isdigit (c
))
7679 /* Read decimal number. */
7681 while (*s
< end
&& (c
= *(*s
)++, isdigit (c
)))
7682 val
= 10 * val
+ c
- '0';
7693 /* Read FILE into memory. Value is a pointer to a buffer allocated
7694 with xmalloc holding FILE's contents. Value is null if an error
7695 occured. *SIZE is set to the size of the file. */
7698 pbm_read_file (file
, size
)
7706 if (stat (XSTRING (file
)->data
, &st
) == 0
7707 && (fp
= fopen (XSTRING (file
)->data
, "r")) != NULL
7708 && (buf
= (char *) xmalloc (st
.st_size
),
7709 fread (buf
, 1, st
.st_size
, fp
) == st
.st_size
))
7729 /* Load PBM image IMG for use on frame F. */
7737 int width
, height
, max_color_idx
= 0;
7739 Lisp_Object file
, specified_file
;
7740 enum {PBM_MONO
, PBM_GRAY
, PBM_COLOR
} type
;
7741 struct gcpro gcpro1
;
7742 unsigned char *contents
= NULL
;
7743 unsigned char *end
, *p
;
7746 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
7750 if (STRINGP (specified_file
))
7752 file
= x_find_image_file (specified_file
);
7753 if (!STRINGP (file
))
7755 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
7760 contents
= pbm_read_file (file
, &size
);
7761 if (contents
== NULL
)
7763 image_error ("Error reading `%s'", file
, Qnil
);
7769 end
= contents
+ size
;
7774 data
= image_spec_value (img
->spec
, QCdata
, NULL
);
7775 p
= XSTRING (data
)->data
;
7776 end
= p
+ STRING_BYTES (XSTRING (data
));
7779 /* Check magic number. */
7780 if (end
- p
< 2 || *p
++ != 'P')
7782 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7792 raw_p
= 0, type
= PBM_MONO
;
7796 raw_p
= 0, type
= PBM_GRAY
;
7800 raw_p
= 0, type
= PBM_COLOR
;
7804 raw_p
= 1, type
= PBM_MONO
;
7808 raw_p
= 1, type
= PBM_GRAY
;
7812 raw_p
= 1, type
= PBM_COLOR
;
7816 image_error ("Not a PBM image: `%s'", img
->spec
, Qnil
);
7820 /* Read width, height, maximum color-component. Characters
7821 starting with `#' up to the end of a line are ignored. */
7822 width
= pbm_scan_number (&p
, end
);
7823 height
= pbm_scan_number (&p
, end
);
7825 if (type
!= PBM_MONO
)
7827 max_color_idx
= pbm_scan_number (&p
, end
);
7828 if (raw_p
&& max_color_idx
> 255)
7829 max_color_idx
= 255;
7834 || (type
!= PBM_MONO
&& max_color_idx
< 0))
7838 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0,
7839 &ximg
, &img
->pixmap
))
7845 /* Initialize the color hash table. */
7846 init_color_table ();
7848 if (type
== PBM_MONO
)
7852 for (y
= 0; y
< height
; ++y
)
7853 for (x
= 0; x
< width
; ++x
)
7863 g
= pbm_scan_number (&p
, end
);
7865 XPutPixel (ximg
, x
, y
, (g
7866 ? FRAME_FOREGROUND_PIXEL (f
)
7867 : FRAME_BACKGROUND_PIXEL (f
)));
7872 for (y
= 0; y
< height
; ++y
)
7873 for (x
= 0; x
< width
; ++x
)
7877 if (type
== PBM_GRAY
)
7878 r
= g
= b
= raw_p
? *p
++ : pbm_scan_number (&p
, end
);
7887 r
= pbm_scan_number (&p
, end
);
7888 g
= pbm_scan_number (&p
, end
);
7889 b
= pbm_scan_number (&p
, end
);
7892 if (r
< 0 || g
< 0 || b
< 0)
7896 XDestroyImage (ximg
);
7898 image_error ("Invalid pixel value in image `%s'",
7903 /* RGB values are now in the range 0..max_color_idx.
7904 Scale this to the range 0..0xffff supported by X. */
7905 r
= (double) r
* 65535 / max_color_idx
;
7906 g
= (double) g
* 65535 / max_color_idx
;
7907 b
= (double) b
* 65535 / max_color_idx
;
7908 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
7912 /* Store in IMG->colors the colors allocated for the image, and
7913 free the color table. */
7914 img
->colors
= colors_in_color_table (&img
->ncolors
);
7915 free_color_table ();
7917 /* Put the image into a pixmap. */
7918 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
7919 x_destroy_x_image (ximg
);
7923 img
->height
= height
;
7932 /***********************************************************************
7934 ***********************************************************************/
7940 /* Function prototypes. */
7942 static int png_image_p
P_ ((Lisp_Object object
));
7943 static int png_load
P_ ((struct frame
*f
, struct image
*img
));
7945 /* The symbol `png' identifying images of this type. */
7949 /* Indices of image specification fields in png_format, below. */
7951 enum png_keyword_index
7964 /* Vector of image_keyword structures describing the format
7965 of valid user-defined image specifications. */
7967 static struct image_keyword png_format
[PNG_LAST
] =
7969 {":type", IMAGE_SYMBOL_VALUE
, 1},
7970 {":data", IMAGE_STRING_VALUE
, 0},
7971 {":file", IMAGE_STRING_VALUE
, 0},
7972 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
7973 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
7974 {":relief", IMAGE_INTEGER_VALUE
, 0},
7975 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
7976 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
7979 /* Structure describing the image type `png'. */
7981 static struct image_type png_type
=
7991 /* Return non-zero if OBJECT is a valid PNG image specification. */
7994 png_image_p (object
)
7997 struct image_keyword fmt
[PNG_LAST
];
7998 bcopy (png_format
, fmt
, sizeof fmt
);
8000 if (!parse_image_spec (object
, fmt
, PNG_LAST
, Qpng
)
8001 || (fmt
[PNG_ASCENT
].count
8002 && XFASTINT (fmt
[PNG_ASCENT
].value
) > 100))
8005 /* Must specify either the :data or :file keyword. */
8006 return fmt
[PNG_FILE
].count
+ fmt
[PNG_DATA
].count
== 1;
8010 /* Error and warning handlers installed when the PNG library
8014 my_png_error (png_ptr
, msg
)
8015 png_struct
*png_ptr
;
8018 xassert (png_ptr
!= NULL
);
8019 image_error ("PNG error: %s", build_string (msg
), Qnil
);
8020 longjmp (png_ptr
->jmpbuf
, 1);
8025 my_png_warning (png_ptr
, msg
)
8026 png_struct
*png_ptr
;
8029 xassert (png_ptr
!= NULL
);
8030 image_error ("PNG warning: %s", build_string (msg
), Qnil
);
8033 /* Memory source for PNG decoding. */
8035 struct png_memory_storage
8037 unsigned char *bytes
; /* The data */
8038 size_t len
; /* How big is it? */
8039 int index
; /* Where are we? */
8043 /* Function set as reader function when reading PNG image from memory.
8044 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8045 bytes from the input to DATA. */
8048 png_read_from_memory (png_ptr
, data
, length
)
8049 png_structp png_ptr
;
8053 struct png_memory_storage
*tbr
8054 = (struct png_memory_storage
*) png_get_io_ptr (png_ptr
);
8056 if (length
> tbr
->len
- tbr
->index
)
8057 png_error (png_ptr
, "Read error");
8059 bcopy (tbr
->bytes
+ tbr
->index
, data
, length
);
8060 tbr
->index
= tbr
->index
+ length
;
8063 /* Load PNG image IMG for use on frame F. Value is non-zero if
8071 Lisp_Object file
, specified_file
;
8072 Lisp_Object specified_data
;
8074 XImage
*ximg
, *mask_img
= NULL
;
8075 struct gcpro gcpro1
;
8076 png_struct
*png_ptr
= NULL
;
8077 png_info
*info_ptr
= NULL
, *end_info
= NULL
;
8080 png_byte
*pixels
= NULL
;
8081 png_byte
**rows
= NULL
;
8082 png_uint_32 width
, height
;
8083 int bit_depth
, color_type
, interlace_type
;
8085 png_uint_32 row_bytes
;
8088 double screen_gamma
, image_gamma
;
8090 struct png_memory_storage tbr
; /* Data to be read */
8092 /* Find out what file to load. */
8093 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8094 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8098 if (NILP (specified_data
))
8100 file
= x_find_image_file (specified_file
);
8101 if (!STRINGP (file
))
8103 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8108 /* Open the image file. */
8109 fp
= fopen (XSTRING (file
)->data
, "rb");
8112 image_error ("Cannot open image file `%s'", file
, Qnil
);
8118 /* Check PNG signature. */
8119 if (fread (sig
, 1, sizeof sig
, fp
) != sizeof sig
8120 || !png_check_sig (sig
, sizeof sig
))
8122 image_error ("Not a PNG file: `%s'", file
, Qnil
);
8130 /* Read from memory. */
8131 tbr
.bytes
= XSTRING (specified_data
)->data
;
8132 tbr
.len
= STRING_BYTES (XSTRING (specified_data
));
8135 /* Check PNG signature. */
8136 if (tbr
.len
< sizeof sig
8137 || !png_check_sig (tbr
.bytes
, sizeof sig
))
8139 image_error ("Not a PNG image: `%s'", img
->spec
, Qnil
);
8144 /* Need to skip past the signature. */
8145 tbr
.bytes
+= sizeof (sig
);
8148 /* Initialize read and info structs for PNG lib. */
8149 png_ptr
= png_create_read_struct (PNG_LIBPNG_VER_STRING
, NULL
,
8150 my_png_error
, my_png_warning
);
8153 if (fp
) fclose (fp
);
8158 info_ptr
= png_create_info_struct (png_ptr
);
8161 png_destroy_read_struct (&png_ptr
, NULL
, NULL
);
8162 if (fp
) fclose (fp
);
8167 end_info
= png_create_info_struct (png_ptr
);
8170 png_destroy_read_struct (&png_ptr
, &info_ptr
, NULL
);
8171 if (fp
) fclose (fp
);
8176 /* Set error jump-back. We come back here when the PNG library
8177 detects an error. */
8178 if (setjmp (png_ptr
->jmpbuf
))
8182 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8185 if (fp
) fclose (fp
);
8190 /* Read image info. */
8191 if (!NILP (specified_data
))
8192 png_set_read_fn (png_ptr
, (void *) &tbr
, png_read_from_memory
);
8194 png_init_io (png_ptr
, fp
);
8196 png_set_sig_bytes (png_ptr
, sizeof sig
);
8197 png_read_info (png_ptr
, info_ptr
);
8198 png_get_IHDR (png_ptr
, info_ptr
, &width
, &height
, &bit_depth
, &color_type
,
8199 &interlace_type
, NULL
, NULL
);
8201 /* If image contains simply transparency data, we prefer to
8202 construct a clipping mask. */
8203 if (png_get_valid (png_ptr
, info_ptr
, PNG_INFO_tRNS
))
8208 /* This function is easier to write if we only have to handle
8209 one data format: RGB or RGBA with 8 bits per channel. Let's
8210 transform other formats into that format. */
8212 /* Strip more than 8 bits per channel. */
8213 if (bit_depth
== 16)
8214 png_set_strip_16 (png_ptr
);
8216 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8218 png_set_expand (png_ptr
);
8220 /* Convert grayscale images to RGB. */
8221 if (color_type
== PNG_COLOR_TYPE_GRAY
8222 || color_type
== PNG_COLOR_TYPE_GRAY_ALPHA
)
8223 png_set_gray_to_rgb (png_ptr
);
8225 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8226 gamma_str
= getenv ("SCREEN_GAMMA");
8227 screen_gamma
= gamma_str
? atof (gamma_str
) : 2.2;
8229 /* Tell the PNG lib to handle gamma correction for us. */
8231 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8232 if (png_get_sRGB (png_ptr
, info_ptr
, &intent
))
8233 /* There is a special chunk in the image specifying the gamma. */
8234 png_set_sRGB (png_ptr
, info_ptr
, intent
);
8237 if (png_get_gAMA (png_ptr
, info_ptr
, &image_gamma
))
8238 /* Image contains gamma information. */
8239 png_set_gamma (png_ptr
, screen_gamma
, image_gamma
);
8241 /* Use a default of 0.5 for the image gamma. */
8242 png_set_gamma (png_ptr
, screen_gamma
, 0.5);
8244 /* Handle alpha channel by combining the image with a background
8245 color. Do this only if a real alpha channel is supplied. For
8246 simple transparency, we prefer a clipping mask. */
8249 png_color_16
*image_background
;
8251 if (png_get_bKGD (png_ptr
, info_ptr
, &image_background
))
8252 /* Image contains a background color with which to
8253 combine the image. */
8254 png_set_background (png_ptr
, image_background
,
8255 PNG_BACKGROUND_GAMMA_FILE
, 1, 1.0);
8258 /* Image does not contain a background color with which
8259 to combine the image data via an alpha channel. Use
8260 the frame's background instead. */
8263 png_color_16 frame_background
;
8266 cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
8267 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
8268 XQueryColor (FRAME_X_DISPLAY (f
), cmap
, &color
);
8271 bzero (&frame_background
, sizeof frame_background
);
8272 frame_background
.red
= color
.red
;
8273 frame_background
.green
= color
.green
;
8274 frame_background
.blue
= color
.blue
;
8276 png_set_background (png_ptr
, &frame_background
,
8277 PNG_BACKGROUND_GAMMA_SCREEN
, 0, 1.0);
8281 /* Update info structure. */
8282 png_read_update_info (png_ptr
, info_ptr
);
8284 /* Get number of channels. Valid values are 1 for grayscale images
8285 and images with a palette, 2 for grayscale images with transparency
8286 information (alpha channel), 3 for RGB images, and 4 for RGB
8287 images with alpha channel, i.e. RGBA. If conversions above were
8288 sufficient we should only have 3 or 4 channels here. */
8289 channels
= png_get_channels (png_ptr
, info_ptr
);
8290 xassert (channels
== 3 || channels
== 4);
8292 /* Number of bytes needed for one row of the image. */
8293 row_bytes
= png_get_rowbytes (png_ptr
, info_ptr
);
8295 /* Allocate memory for the image. */
8296 pixels
= (png_byte
*) xmalloc (row_bytes
* height
* sizeof *pixels
);
8297 rows
= (png_byte
**) xmalloc (height
* sizeof *rows
);
8298 for (i
= 0; i
< height
; ++i
)
8299 rows
[i
] = pixels
+ i
* row_bytes
;
8301 /* Read the entire image. */
8302 png_read_image (png_ptr
, rows
);
8303 png_read_end (png_ptr
, info_ptr
);
8312 /* Create the X image and pixmap. */
8313 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
,
8320 /* Create an image and pixmap serving as mask if the PNG image
8321 contains an alpha channel. */
8324 && !x_create_x_image_and_pixmap (f
, width
, height
, 1,
8325 &mask_img
, &img
->mask
))
8327 x_destroy_x_image (ximg
);
8328 XFreePixmap (FRAME_X_DISPLAY (f
), img
->pixmap
);
8334 /* Fill the X image and mask from PNG data. */
8335 init_color_table ();
8337 for (y
= 0; y
< height
; ++y
)
8339 png_byte
*p
= rows
[y
];
8341 for (x
= 0; x
< width
; ++x
)
8348 XPutPixel (ximg
, x
, y
, lookup_rgb_color (f
, r
, g
, b
));
8350 /* An alpha channel, aka mask channel, associates variable
8351 transparency with an image. Where other image formats
8352 support binary transparency---fully transparent or fully
8353 opaque---PNG allows up to 254 levels of partial transparency.
8354 The PNG library implements partial transparency by combining
8355 the image with a specified background color.
8357 I'm not sure how to handle this here nicely: because the
8358 background on which the image is displayed may change, for
8359 real alpha channel support, it would be necessary to create
8360 a new image for each possible background.
8362 What I'm doing now is that a mask is created if we have
8363 boolean transparency information. Otherwise I'm using
8364 the frame's background color to combine the image with. */
8369 XPutPixel (mask_img
, x
, y
, *p
> 0);
8375 /* Remember colors allocated for this image. */
8376 img
->colors
= colors_in_color_table (&img
->ncolors
);
8377 free_color_table ();
8380 png_destroy_read_struct (&png_ptr
, &info_ptr
, &end_info
);
8385 img
->height
= height
;
8387 /* Put the image into the pixmap, then free the X image and its buffer. */
8388 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8389 x_destroy_x_image (ximg
);
8391 /* Same for the mask. */
8394 x_put_x_image (f
, mask_img
, img
->mask
, img
->width
, img
->height
);
8395 x_destroy_x_image (mask_img
);
8403 #endif /* HAVE_PNG != 0 */
8407 /***********************************************************************
8409 ***********************************************************************/
8413 /* Work around a warning about HAVE_STDLIB_H being redefined in
8415 #ifdef HAVE_STDLIB_H
8416 #define HAVE_STDLIB_H_1
8417 #undef HAVE_STDLIB_H
8418 #endif /* HAVE_STLIB_H */
8420 #include <jpeglib.h>
8424 #ifdef HAVE_STLIB_H_1
8425 #define HAVE_STDLIB_H 1
8428 static int jpeg_image_p
P_ ((Lisp_Object object
));
8429 static int jpeg_load
P_ ((struct frame
*f
, struct image
*img
));
8431 /* The symbol `jpeg' identifying images of this type. */
8435 /* Indices of image specification fields in gs_format, below. */
8437 enum jpeg_keyword_index
8446 JPEG_HEURISTIC_MASK
,
8450 /* Vector of image_keyword structures describing the format
8451 of valid user-defined image specifications. */
8453 static struct image_keyword jpeg_format
[JPEG_LAST
] =
8455 {":type", IMAGE_SYMBOL_VALUE
, 1},
8456 {":data", IMAGE_STRING_VALUE
, 0},
8457 {":file", IMAGE_STRING_VALUE
, 0},
8458 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8459 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8460 {":relief", IMAGE_INTEGER_VALUE
, 0},
8461 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8462 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8465 /* Structure describing the image type `jpeg'. */
8467 static struct image_type jpeg_type
=
8477 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8480 jpeg_image_p (object
)
8483 struct image_keyword fmt
[JPEG_LAST
];
8485 bcopy (jpeg_format
, fmt
, sizeof fmt
);
8487 if (!parse_image_spec (object
, fmt
, JPEG_LAST
, Qjpeg
)
8488 || (fmt
[JPEG_ASCENT
].count
8489 && XFASTINT (fmt
[JPEG_ASCENT
].value
) > 100))
8492 /* Must specify either the :data or :file keyword. */
8493 return fmt
[JPEG_FILE
].count
+ fmt
[JPEG_DATA
].count
== 1;
8497 struct my_jpeg_error_mgr
8499 struct jpeg_error_mgr pub
;
8500 jmp_buf setjmp_buffer
;
8504 my_error_exit (cinfo
)
8507 struct my_jpeg_error_mgr
*mgr
= (struct my_jpeg_error_mgr
*) cinfo
->err
;
8508 longjmp (mgr
->setjmp_buffer
, 1);
8511 /* Init source method for JPEG data source manager. Called by
8512 jpeg_read_header() before any data is actually read. See
8513 libjpeg.doc from the JPEG lib distribution. */
8516 our_init_source (cinfo
)
8517 j_decompress_ptr cinfo
;
8522 /* Fill input buffer method for JPEG data source manager. Called
8523 whenever more data is needed. We read the whole image in one step,
8524 so this only adds a fake end of input marker at the end. */
8527 our_fill_input_buffer (cinfo
)
8528 j_decompress_ptr cinfo
;
8530 /* Insert a fake EOI marker. */
8531 struct jpeg_source_mgr
*src
= cinfo
->src
;
8532 static JOCTET buffer
[2];
8534 buffer
[0] = (JOCTET
) 0xFF;
8535 buffer
[1] = (JOCTET
) JPEG_EOI
;
8537 src
->next_input_byte
= buffer
;
8538 src
->bytes_in_buffer
= 2;
8543 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8544 is the JPEG data source manager. */
8547 our_skip_input_data (cinfo
, num_bytes
)
8548 j_decompress_ptr cinfo
;
8551 struct jpeg_source_mgr
*src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8555 if (num_bytes
> src
->bytes_in_buffer
)
8556 ERREXIT (cinfo
, JERR_INPUT_EOF
);
8558 src
->bytes_in_buffer
-= num_bytes
;
8559 src
->next_input_byte
+= num_bytes
;
8564 /* Method to terminate data source. Called by
8565 jpeg_finish_decompress() after all data has been processed. */
8568 our_term_source (cinfo
)
8569 j_decompress_ptr cinfo
;
8574 /* Set up the JPEG lib for reading an image from DATA which contains
8575 LEN bytes. CINFO is the decompression info structure created for
8576 reading the image. */
8579 jpeg_memory_src (cinfo
, data
, len
)
8580 j_decompress_ptr cinfo
;
8584 struct jpeg_source_mgr
*src
;
8586 if (cinfo
->src
== NULL
)
8588 /* First time for this JPEG object? */
8589 cinfo
->src
= (struct jpeg_source_mgr
*)
8590 (*cinfo
->mem
->alloc_small
) ((j_common_ptr
) cinfo
, JPOOL_PERMANENT
,
8591 sizeof (struct jpeg_source_mgr
));
8592 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8593 src
->next_input_byte
= data
;
8596 src
= (struct jpeg_source_mgr
*) cinfo
->src
;
8597 src
->init_source
= our_init_source
;
8598 src
->fill_input_buffer
= our_fill_input_buffer
;
8599 src
->skip_input_data
= our_skip_input_data
;
8600 src
->resync_to_restart
= jpeg_resync_to_restart
; /* Use default method. */
8601 src
->term_source
= our_term_source
;
8602 src
->bytes_in_buffer
= len
;
8603 src
->next_input_byte
= data
;
8607 /* Load image IMG for use on frame F. Patterned after example.c
8608 from the JPEG lib. */
8615 struct jpeg_decompress_struct cinfo
;
8616 struct my_jpeg_error_mgr mgr
;
8617 Lisp_Object file
, specified_file
;
8618 Lisp_Object specified_data
;
8621 int row_stride
, x
, y
;
8622 XImage
*ximg
= NULL
;
8624 unsigned long *colors
;
8626 struct gcpro gcpro1
;
8628 /* Open the JPEG file. */
8629 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8630 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8634 if (NILP (specified_data
))
8636 file
= x_find_image_file (specified_file
);
8637 if (!STRINGP (file
))
8639 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
8644 fp
= fopen (XSTRING (file
)->data
, "r");
8647 image_error ("Cannot open `%s'", file
, Qnil
);
8653 /* Customize libjpeg's error handling to call my_error_exit when an
8654 error is detected. This function will perform a longjmp. */
8655 mgr
.pub
.error_exit
= my_error_exit
;
8656 cinfo
.err
= jpeg_std_error (&mgr
.pub
);
8658 if ((rc
= setjmp (mgr
.setjmp_buffer
)) != 0)
8662 /* Called from my_error_exit. Display a JPEG error. */
8663 char buffer
[JMSG_LENGTH_MAX
];
8664 cinfo
.err
->format_message ((j_common_ptr
) &cinfo
, buffer
);
8665 image_error ("Error reading JPEG image `%s': %s", img
->spec
,
8666 build_string (buffer
));
8669 /* Close the input file and destroy the JPEG object. */
8672 jpeg_destroy_decompress (&cinfo
);
8676 /* If we already have an XImage, free that. */
8677 x_destroy_x_image (ximg
);
8679 /* Free pixmap and colors. */
8680 x_clear_image (f
, img
);
8687 /* Create the JPEG decompression object. Let it read from fp.
8688 Read the JPEG image header. */
8689 jpeg_create_decompress (&cinfo
);
8691 if (NILP (specified_data
))
8692 jpeg_stdio_src (&cinfo
, fp
);
8694 jpeg_memory_src (&cinfo
, XSTRING (specified_data
)->data
,
8695 STRING_BYTES (XSTRING (specified_data
)));
8697 jpeg_read_header (&cinfo
, TRUE
);
8699 /* Customize decompression so that color quantization will be used.
8700 Start decompression. */
8701 cinfo
.quantize_colors
= TRUE
;
8702 jpeg_start_decompress (&cinfo
);
8703 width
= img
->width
= cinfo
.output_width
;
8704 height
= img
->height
= cinfo
.output_height
;
8708 /* Create X image and pixmap. */
8709 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
8712 longjmp (mgr
.setjmp_buffer
, 2);
8715 /* Allocate colors. When color quantization is used,
8716 cinfo.actual_number_of_colors has been set with the number of
8717 colors generated, and cinfo.colormap is a two-dimensional array
8718 of color indices in the range 0..cinfo.actual_number_of_colors.
8719 No more than 255 colors will be generated. */
8723 if (cinfo
.out_color_components
> 2)
8724 ir
= 0, ig
= 1, ib
= 2;
8725 else if (cinfo
.out_color_components
> 1)
8726 ir
= 0, ig
= 1, ib
= 0;
8728 ir
= 0, ig
= 0, ib
= 0;
8730 /* Use the color table mechanism because it handles colors that
8731 cannot be allocated nicely. Such colors will be replaced with
8732 a default color, and we don't have to care about which colors
8733 can be freed safely, and which can't. */
8734 init_color_table ();
8735 colors
= (unsigned long *) alloca (cinfo
.actual_number_of_colors
8738 for (i
= 0; i
< cinfo
.actual_number_of_colors
; ++i
)
8740 /* Multiply RGB values with 255 because X expects RGB values
8741 in the range 0..0xffff. */
8742 int r
= cinfo
.colormap
[ir
][i
] << 8;
8743 int g
= cinfo
.colormap
[ig
][i
] << 8;
8744 int b
= cinfo
.colormap
[ib
][i
] << 8;
8745 colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
8748 /* Remember those colors actually allocated. */
8749 img
->colors
= colors_in_color_table (&img
->ncolors
);
8750 free_color_table ();
8754 row_stride
= width
* cinfo
.output_components
;
8755 buffer
= cinfo
.mem
->alloc_sarray ((j_common_ptr
) &cinfo
, JPOOL_IMAGE
,
8757 for (y
= 0; y
< height
; ++y
)
8759 jpeg_read_scanlines (&cinfo
, buffer
, 1);
8760 for (x
= 0; x
< cinfo
.output_width
; ++x
)
8761 XPutPixel (ximg
, x
, y
, colors
[buffer
[0][x
]]);
8765 jpeg_finish_decompress (&cinfo
);
8766 jpeg_destroy_decompress (&cinfo
);
8770 /* Put the image into the pixmap. */
8771 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
8772 x_destroy_x_image (ximg
);
8778 #endif /* HAVE_JPEG */
8782 /***********************************************************************
8784 ***********************************************************************/
8790 static int tiff_image_p
P_ ((Lisp_Object object
));
8791 static int tiff_load
P_ ((struct frame
*f
, struct image
*img
));
8793 /* The symbol `tiff' identifying images of this type. */
8797 /* Indices of image specification fields in tiff_format, below. */
8799 enum tiff_keyword_index
8808 TIFF_HEURISTIC_MASK
,
8812 /* Vector of image_keyword structures describing the format
8813 of valid user-defined image specifications. */
8815 static struct image_keyword tiff_format
[TIFF_LAST
] =
8817 {":type", IMAGE_SYMBOL_VALUE
, 1},
8818 {":data", IMAGE_STRING_VALUE
, 0},
8819 {":file", IMAGE_STRING_VALUE
, 0},
8820 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
8821 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
8822 {":relief", IMAGE_INTEGER_VALUE
, 0},
8823 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
8824 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
8827 /* Structure describing the image type `tiff'. */
8829 static struct image_type tiff_type
=
8839 /* Return non-zero if OBJECT is a valid TIFF image specification. */
8842 tiff_image_p (object
)
8845 struct image_keyword fmt
[TIFF_LAST
];
8846 bcopy (tiff_format
, fmt
, sizeof fmt
);
8848 if (!parse_image_spec (object
, fmt
, TIFF_LAST
, Qtiff
)
8849 || (fmt
[TIFF_ASCENT
].count
8850 && XFASTINT (fmt
[TIFF_ASCENT
].value
) > 100))
8853 /* Must specify either the :data or :file keyword. */
8854 return fmt
[TIFF_FILE
].count
+ fmt
[TIFF_DATA
].count
== 1;
8858 /* Reading from a memory buffer for TIFF images Based on the PNG
8859 memory source, but we have to provide a lot of extra functions.
8862 We really only need to implement read and seek, but I am not
8863 convinced that the TIFF library is smart enough not to destroy
8864 itself if we only hand it the function pointers we need to
8869 unsigned char *bytes
;
8876 tiff_read_from_memory (data
, buf
, size
)
8881 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8883 if (size
> src
->len
- src
->index
)
8885 bcopy (src
->bytes
+ src
->index
, buf
, size
);
8891 tiff_write_from_memory (data
, buf
, size
)
8900 tiff_seek_in_memory (data
, off
, whence
)
8905 tiff_memory_source
*src
= (tiff_memory_source
*) data
;
8910 case SEEK_SET
: /* Go from beginning of source. */
8914 case SEEK_END
: /* Go from end of source. */
8915 idx
= src
->len
+ off
;
8918 case SEEK_CUR
: /* Go from current position. */
8919 idx
= src
->index
+ off
;
8922 default: /* Invalid `whence'. */
8926 if (idx
> src
->len
|| idx
< 0)
8934 tiff_close_memory (data
)
8942 tiff_mmap_memory (data
, pbase
, psize
)
8947 /* It is already _IN_ memory. */
8952 tiff_unmap_memory (data
, base
, size
)
8957 /* We don't need to do this. */
8961 tiff_size_of_memory (data
)
8964 return ((tiff_memory_source
*) data
)->len
;
8967 /* Load TIFF image IMG for use on frame F. Value is non-zero if
8975 Lisp_Object file
, specified_file
;
8976 Lisp_Object specified_data
;
8978 int width
, height
, x
, y
;
8982 struct gcpro gcpro1
;
8983 tiff_memory_source memsrc
;
8985 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
8986 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
8990 if (NILP (specified_data
))
8992 /* Read from a file */
8993 file
= x_find_image_file (specified_file
);
8994 if (!STRINGP (file
))
8996 image_error ("Cannot find image file `%s'", file
, Qnil
);
9001 /* Try to open the image file. */
9002 tiff
= TIFFOpen (XSTRING (file
)->data
, "r");
9005 image_error ("Cannot open `%s'", file
, Qnil
);
9012 /* Memory source! */
9013 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9014 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9017 tiff
= TIFFClientOpen ("memory_source", "r", &memsrc
,
9018 (TIFFReadWriteProc
) tiff_read_from_memory
,
9019 (TIFFReadWriteProc
) tiff_write_from_memory
,
9020 tiff_seek_in_memory
,
9022 tiff_size_of_memory
,
9028 image_error ("Cannot open memory source for `%s'", img
->spec
, Qnil
);
9034 /* Get width and height of the image, and allocate a raster buffer
9035 of width x height 32-bit values. */
9036 TIFFGetField (tiff
, TIFFTAG_IMAGEWIDTH
, &width
);
9037 TIFFGetField (tiff
, TIFFTAG_IMAGELENGTH
, &height
);
9038 buf
= (uint32
*) xmalloc (width
* height
* sizeof *buf
);
9040 rc
= TIFFReadRGBAImage (tiff
, width
, height
, buf
, 0);
9044 image_error ("Error reading TIFF image `%s'", img
->spec
, Qnil
);
9052 /* Create the X image and pixmap. */
9053 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9061 /* Initialize the color table. */
9062 init_color_table ();
9064 /* Process the pixel raster. Origin is in the lower-left corner. */
9065 for (y
= 0; y
< height
; ++y
)
9067 uint32
*row
= buf
+ y
* width
;
9069 for (x
= 0; x
< width
; ++x
)
9071 uint32 abgr
= row
[x
];
9072 int r
= TIFFGetR (abgr
) << 8;
9073 int g
= TIFFGetG (abgr
) << 8;
9074 int b
= TIFFGetB (abgr
) << 8;
9075 XPutPixel (ximg
, x
, height
- 1 - y
, lookup_rgb_color (f
, r
, g
, b
));
9079 /* Remember the colors allocated for the image. Free the color table. */
9080 img
->colors
= colors_in_color_table (&img
->ncolors
);
9081 free_color_table ();
9083 /* Put the image into the pixmap, then free the X image and its buffer. */
9084 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9085 x_destroy_x_image (ximg
);
9090 img
->height
= height
;
9096 #endif /* HAVE_TIFF != 0 */
9100 /***********************************************************************
9102 ***********************************************************************/
9106 #include <gif_lib.h>
9108 static int gif_image_p
P_ ((Lisp_Object object
));
9109 static int gif_load
P_ ((struct frame
*f
, struct image
*img
));
9111 /* The symbol `gif' identifying images of this type. */
9115 /* Indices of image specification fields in gif_format, below. */
9117 enum gif_keyword_index
9131 /* Vector of image_keyword structures describing the format
9132 of valid user-defined image specifications. */
9134 static struct image_keyword gif_format
[GIF_LAST
] =
9136 {":type", IMAGE_SYMBOL_VALUE
, 1},
9137 {":data", IMAGE_STRING_VALUE
, 0},
9138 {":file", IMAGE_STRING_VALUE
, 0},
9139 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9140 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9141 {":relief", IMAGE_INTEGER_VALUE
, 0},
9142 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9143 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9144 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0}
9147 /* Structure describing the image type `gif'. */
9149 static struct image_type gif_type
=
9158 /* Return non-zero if OBJECT is a valid GIF image specification. */
9161 gif_image_p (object
)
9164 struct image_keyword fmt
[GIF_LAST
];
9165 bcopy (gif_format
, fmt
, sizeof fmt
);
9167 if (!parse_image_spec (object
, fmt
, GIF_LAST
, Qgif
)
9168 || (fmt
[GIF_ASCENT
].count
9169 && XFASTINT (fmt
[GIF_ASCENT
].value
) > 100))
9172 /* Must specify either the :data or :file keyword. */
9173 return fmt
[GIF_FILE
].count
+ fmt
[GIF_DATA
].count
== 1;
9176 /* Reading a GIF image from memory
9177 Based on the PNG memory stuff to a certain extent. */
9181 unsigned char *bytes
;
9187 /* Make the current memory source available to gif_read_from_memory.
9188 It's done this way because not all versions of libungif support
9189 a UserData field in the GifFileType structure. */
9190 static gif_memory_source
*current_gif_memory_src
;
9193 gif_read_from_memory (file
, buf
, len
)
9198 gif_memory_source
*src
= current_gif_memory_src
;
9200 if (len
> src
->len
- src
->index
)
9203 bcopy (src
->bytes
+ src
->index
, buf
, len
);
9209 /* Load GIF image IMG for use on frame F. Value is non-zero if
9217 Lisp_Object file
, specified_file
;
9218 Lisp_Object specified_data
;
9219 int rc
, width
, height
, x
, y
, i
;
9221 ColorMapObject
*gif_color_map
;
9222 unsigned long pixel_colors
[256];
9224 struct gcpro gcpro1
;
9226 int ino
, image_left
, image_top
, image_width
, image_height
;
9227 gif_memory_source memsrc
;
9228 unsigned char *raster
;
9230 specified_file
= image_spec_value (img
->spec
, QCfile
, NULL
);
9231 specified_data
= image_spec_value (img
->spec
, QCdata
, NULL
);
9235 if (NILP (specified_data
))
9237 file
= x_find_image_file (specified_file
);
9238 if (!STRINGP (file
))
9240 image_error ("Cannot find image file `%s'", specified_file
, Qnil
);
9245 /* Open the GIF file. */
9246 gif
= DGifOpenFileName (XSTRING (file
)->data
);
9249 image_error ("Cannot open `%s'", file
, Qnil
);
9256 /* Read from memory! */
9257 current_gif_memory_src
= &memsrc
;
9258 memsrc
.bytes
= XSTRING (specified_data
)->data
;
9259 memsrc
.len
= STRING_BYTES (XSTRING (specified_data
));
9262 gif
= DGifOpen(&memsrc
, gif_read_from_memory
);
9265 image_error ("Cannot open memory source `%s'", img
->spec
, Qnil
);
9271 /* Read entire contents. */
9272 rc
= DGifSlurp (gif
);
9273 if (rc
== GIF_ERROR
)
9275 image_error ("Error reading `%s'", img
->spec
, Qnil
);
9276 DGifCloseFile (gif
);
9281 image
= image_spec_value (img
->spec
, QCindex
, NULL
);
9282 ino
= INTEGERP (image
) ? XFASTINT (image
) : 0;
9283 if (ino
>= gif
->ImageCount
)
9285 image_error ("Invalid image number `%s' in image `%s'",
9287 DGifCloseFile (gif
);
9292 width
= img
->width
= gif
->SWidth
;
9293 height
= img
->height
= gif
->SHeight
;
9297 /* Create the X image and pixmap. */
9298 if (!x_create_x_image_and_pixmap (f
, width
, height
, 0, &ximg
, &img
->pixmap
))
9301 DGifCloseFile (gif
);
9306 /* Allocate colors. */
9307 gif_color_map
= gif
->SavedImages
[ino
].ImageDesc
.ColorMap
;
9309 gif_color_map
= gif
->SColorMap
;
9310 init_color_table ();
9311 bzero (pixel_colors
, sizeof pixel_colors
);
9313 for (i
= 0; i
< gif_color_map
->ColorCount
; ++i
)
9315 int r
= gif_color_map
->Colors
[i
].Red
<< 8;
9316 int g
= gif_color_map
->Colors
[i
].Green
<< 8;
9317 int b
= gif_color_map
->Colors
[i
].Blue
<< 8;
9318 pixel_colors
[i
] = lookup_rgb_color (f
, r
, g
, b
);
9321 img
->colors
= colors_in_color_table (&img
->ncolors
);
9322 free_color_table ();
9324 /* Clear the part of the screen image that are not covered by
9325 the image from the GIF file. Full animated GIF support
9326 requires more than can be done here (see the gif89 spec,
9327 disposal methods). Let's simply assume that the part
9328 not covered by a sub-image is in the frame's background color. */
9329 image_top
= gif
->SavedImages
[ino
].ImageDesc
.Top
;
9330 image_left
= gif
->SavedImages
[ino
].ImageDesc
.Left
;
9331 image_width
= gif
->SavedImages
[ino
].ImageDesc
.Width
;
9332 image_height
= gif
->SavedImages
[ino
].ImageDesc
.Height
;
9334 for (y
= 0; y
< image_top
; ++y
)
9335 for (x
= 0; x
< width
; ++x
)
9336 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9338 for (y
= image_top
+ image_height
; y
< height
; ++y
)
9339 for (x
= 0; x
< width
; ++x
)
9340 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9342 for (y
= image_top
; y
< image_top
+ image_height
; ++y
)
9344 for (x
= 0; x
< image_left
; ++x
)
9345 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9346 for (x
= image_left
+ image_width
; x
< width
; ++x
)
9347 XPutPixel (ximg
, x
, y
, FRAME_BACKGROUND_PIXEL (f
));
9350 /* Read the GIF image into the X image. We use a local variable
9351 `raster' here because RasterBits below is a char *, and invites
9352 problems with bytes >= 0x80. */
9353 raster
= (unsigned char *) gif
->SavedImages
[ino
].RasterBits
;
9355 if (gif
->SavedImages
[ino
].ImageDesc
.Interlace
)
9357 static int interlace_start
[] = {0, 4, 2, 1};
9358 static int interlace_increment
[] = {8, 8, 4, 2};
9360 int row
= interlace_start
[0];
9364 for (y
= 0; y
< image_height
; y
++)
9366 if (row
>= image_height
)
9368 row
= interlace_start
[++pass
];
9369 while (row
>= image_height
)
9370 row
= interlace_start
[++pass
];
9373 for (x
= 0; x
< image_width
; x
++)
9375 int i
= raster
[(y
* image_width
) + x
];
9376 XPutPixel (ximg
, x
+ image_left
, row
+ image_top
,
9380 row
+= interlace_increment
[pass
];
9385 for (y
= 0; y
< image_height
; ++y
)
9386 for (x
= 0; x
< image_width
; ++x
)
9388 int i
= raster
[y
* image_width
+ x
];
9389 XPutPixel (ximg
, x
+ image_left
, y
+ image_top
, pixel_colors
[i
]);
9393 DGifCloseFile (gif
);
9395 /* Put the image into the pixmap, then free the X image and its buffer. */
9396 x_put_x_image (f
, ximg
, img
->pixmap
, width
, height
);
9397 x_destroy_x_image (ximg
);
9404 #endif /* HAVE_GIF != 0 */
9408 /***********************************************************************
9410 ***********************************************************************/
9412 static int gs_image_p
P_ ((Lisp_Object object
));
9413 static int gs_load
P_ ((struct frame
*f
, struct image
*img
));
9414 static void gs_clear_image
P_ ((struct frame
*f
, struct image
*img
));
9416 /* The symbol `postscript' identifying images of this type. */
9418 Lisp_Object Qpostscript
;
9420 /* Keyword symbols. */
9422 Lisp_Object QCloader
, QCbounding_box
, QCpt_width
, QCpt_height
;
9424 /* Indices of image specification fields in gs_format, below. */
9426 enum gs_keyword_index
9442 /* Vector of image_keyword structures describing the format
9443 of valid user-defined image specifications. */
9445 static struct image_keyword gs_format
[GS_LAST
] =
9447 {":type", IMAGE_SYMBOL_VALUE
, 1},
9448 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9449 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE
, 1},
9450 {":file", IMAGE_STRING_VALUE
, 1},
9451 {":loader", IMAGE_FUNCTION_VALUE
, 0},
9452 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE
, 1},
9453 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE
, 0},
9454 {":margin", IMAGE_POSITIVE_INTEGER_VALUE
, 0},
9455 {":relief", IMAGE_INTEGER_VALUE
, 0},
9456 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE
, 0},
9457 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE
, 0}
9460 /* Structure describing the image type `ghostscript'. */
9462 static struct image_type gs_type
=
9472 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9475 gs_clear_image (f
, img
)
9479 /* IMG->data.ptr_val may contain a recorded colormap. */
9480 xfree (img
->data
.ptr_val
);
9481 x_clear_image (f
, img
);
9485 /* Return non-zero if OBJECT is a valid Ghostscript image
9492 struct image_keyword fmt
[GS_LAST
];
9496 bcopy (gs_format
, fmt
, sizeof fmt
);
9498 if (!parse_image_spec (object
, fmt
, GS_LAST
, Qpostscript
)
9499 || (fmt
[GS_ASCENT
].count
9500 && XFASTINT (fmt
[GS_ASCENT
].value
) > 100))
9503 /* Bounding box must be a list or vector containing 4 integers. */
9504 tem
= fmt
[GS_BOUNDING_BOX
].value
;
9507 for (i
= 0; i
< 4; ++i
, tem
= XCDR (tem
))
9508 if (!CONSP (tem
) || !INTEGERP (XCAR (tem
)))
9513 else if (VECTORP (tem
))
9515 if (XVECTOR (tem
)->size
!= 4)
9517 for (i
= 0; i
< 4; ++i
)
9518 if (!INTEGERP (XVECTOR (tem
)->contents
[i
]))
9528 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9537 Lisp_Object window_and_pixmap_id
= Qnil
, loader
, pt_height
, pt_width
;
9538 struct gcpro gcpro1
, gcpro2
;
9540 double in_width
, in_height
;
9541 Lisp_Object pixel_colors
= Qnil
;
9543 /* Compute pixel size of pixmap needed from the given size in the
9544 image specification. Sizes in the specification are in pt. 1 pt
9545 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9547 pt_width
= image_spec_value (img
->spec
, QCpt_width
, NULL
);
9548 in_width
= XFASTINT (pt_width
) / 72.0;
9549 img
->width
= in_width
* FRAME_X_DISPLAY_INFO (f
)->resx
;
9550 pt_height
= image_spec_value (img
->spec
, QCpt_height
, NULL
);
9551 in_height
= XFASTINT (pt_height
) / 72.0;
9552 img
->height
= in_height
* FRAME_X_DISPLAY_INFO (f
)->resy
;
9554 /* Create the pixmap. */
9556 xassert (img
->pixmap
== 0);
9557 img
->pixmap
= XCreatePixmap (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9558 img
->width
, img
->height
,
9559 DefaultDepthOfScreen (FRAME_X_SCREEN (f
)));
9564 image_error ("Unable to create pixmap for `%s'", img
->spec
, Qnil
);
9568 /* Call the loader to fill the pixmap. It returns a process object
9569 if successful. We do not record_unwind_protect here because
9570 other places in redisplay like calling window scroll functions
9571 don't either. Let the Lisp loader use `unwind-protect' instead. */
9572 GCPRO2 (window_and_pixmap_id
, pixel_colors
);
9574 sprintf (buffer
, "%lu %lu",
9575 (unsigned long) FRAME_X_WINDOW (f
),
9576 (unsigned long) img
->pixmap
);
9577 window_and_pixmap_id
= build_string (buffer
);
9579 sprintf (buffer
, "%lu %lu",
9580 FRAME_FOREGROUND_PIXEL (f
),
9581 FRAME_BACKGROUND_PIXEL (f
));
9582 pixel_colors
= build_string (buffer
);
9584 XSETFRAME (frame
, f
);
9585 loader
= image_spec_value (img
->spec
, QCloader
, NULL
);
9587 loader
= intern ("gs-load-image");
9589 img
->data
.lisp_val
= call6 (loader
, frame
, img
->spec
,
9590 make_number (img
->width
),
9591 make_number (img
->height
),
9592 window_and_pixmap_id
,
9595 return PROCESSP (img
->data
.lisp_val
);
9599 /* Kill the Ghostscript process that was started to fill PIXMAP on
9600 frame F. Called from XTread_socket when receiving an event
9601 telling Emacs that Ghostscript has finished drawing. */
9604 x_kill_gs_process (pixmap
, f
)
9608 struct image_cache
*c
= FRAME_X_IMAGE_CACHE (f
);
9612 /* Find the image containing PIXMAP. */
9613 for (i
= 0; i
< c
->used
; ++i
)
9614 if (c
->images
[i
]->pixmap
== pixmap
)
9617 /* Kill the GS process. We should have found PIXMAP in the image
9618 cache and its image should contain a process object. */
9619 xassert (i
< c
->used
);
9621 xassert (PROCESSP (img
->data
.lisp_val
));
9622 Fkill_process (img
->data
.lisp_val
, Qnil
);
9623 img
->data
.lisp_val
= Qnil
;
9625 /* On displays with a mutable colormap, figure out the colors
9626 allocated for the image by looking at the pixels of an XImage for
9628 class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
9629 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
9635 /* Try to get an XImage for img->pixmep. */
9636 ximg
= XGetImage (FRAME_X_DISPLAY (f
), img
->pixmap
,
9637 0, 0, img
->width
, img
->height
, ~0, ZPixmap
);
9642 /* Initialize the color table. */
9643 init_color_table ();
9645 /* For each pixel of the image, look its color up in the
9646 color table. After having done so, the color table will
9647 contain an entry for each color used by the image. */
9648 for (y
= 0; y
< img
->height
; ++y
)
9649 for (x
= 0; x
< img
->width
; ++x
)
9651 unsigned long pixel
= XGetPixel (ximg
, x
, y
);
9652 lookup_pixel_color (f
, pixel
);
9655 /* Record colors in the image. Free color table and XImage. */
9656 img
->colors
= colors_in_color_table (&img
->ncolors
);
9657 free_color_table ();
9658 XDestroyImage (ximg
);
9660 #if 0 /* This doesn't seem to be the case. If we free the colors
9661 here, we get a BadAccess later in x_clear_image when
9662 freeing the colors. */
9663 /* We have allocated colors once, but Ghostscript has also
9664 allocated colors on behalf of us. So, to get the
9665 reference counts right, free them once. */
9668 Colormap cmap
= DefaultColormapOfScreen (FRAME_X_SCREEN (f
));
9669 XFreeColors (FRAME_X_DISPLAY (f
), cmap
,
9670 img
->colors
, img
->ncolors
, 0);
9675 image_error ("Cannot get X image of `%s'; colors will not be freed",
9684 /***********************************************************************
9686 ***********************************************************************/
9688 DEFUN ("x-change-window-property", Fx_change_window_property
,
9689 Sx_change_window_property
, 2, 3, 0,
9690 "Change window property PROP to VALUE on the X window of FRAME.\n\
9691 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9692 selected frame. Value is VALUE.")
9693 (prop
, value
, frame
)
9694 Lisp_Object frame
, prop
, value
;
9696 struct frame
*f
= check_x_frame (frame
);
9699 CHECK_STRING (prop
, 1);
9700 CHECK_STRING (value
, 2);
9703 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9704 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9705 prop_atom
, XA_STRING
, 8, PropModeReplace
,
9706 XSTRING (value
)->data
, XSTRING (value
)->size
);
9708 /* Make sure the property is set when we return. */
9709 XFlush (FRAME_X_DISPLAY (f
));
9716 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
9717 Sx_delete_window_property
, 1, 2, 0,
9718 "Remove window property PROP from X window of FRAME.\n\
9719 FRAME nil or omitted means use the selected frame. Value is PROP.")
9721 Lisp_Object prop
, frame
;
9723 struct frame
*f
= check_x_frame (frame
);
9726 CHECK_STRING (prop
, 1);
9728 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9729 XDeleteProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), prop_atom
);
9731 /* Make sure the property is removed when we return. */
9732 XFlush (FRAME_X_DISPLAY (f
));
9739 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
9741 "Value is the value of window property PROP on FRAME.\n\
9742 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9743 if FRAME hasn't a property with name PROP or if PROP has no string\n\
9746 Lisp_Object prop
, frame
;
9748 struct frame
*f
= check_x_frame (frame
);
9751 Lisp_Object prop_value
= Qnil
;
9752 char *tmp_data
= NULL
;
9755 unsigned long actual_size
, bytes_remaining
;
9757 CHECK_STRING (prop
, 1);
9759 prop_atom
= XInternAtom (FRAME_X_DISPLAY (f
), XSTRING (prop
)->data
, False
);
9760 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9761 prop_atom
, 0, 0, False
, XA_STRING
,
9762 &actual_type
, &actual_format
, &actual_size
,
9763 &bytes_remaining
, (unsigned char **) &tmp_data
);
9766 int size
= bytes_remaining
;
9771 rc
= XGetWindowProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
9772 prop_atom
, 0, bytes_remaining
,
9774 &actual_type
, &actual_format
,
9775 &actual_size
, &bytes_remaining
,
9776 (unsigned char **) &tmp_data
);
9778 prop_value
= make_string (tmp_data
, size
);
9789 /***********************************************************************
9791 ***********************************************************************/
9793 /* The implementation partly follows a patch from
9794 F.Pierresteguy@frcl.bull.fr dated 1994. */
9796 /* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9797 the next X event is read and we enter XTread_socket again. Setting
9798 it to 1 inhibits busy-cursor display for direct commands. */
9800 int inhibit_busy_cursor
;
9802 /* Incremented with each call to x-display-busy-cursor.
9803 Decremented in x-undisplay-busy-cursor. */
9805 static int busy_count
;
9808 DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor
,
9809 Sx_show_busy_cursor
, 0, 0, 0,
9810 "Show a busy cursor, if not already shown.\n\
9811 Each call to this function must be matched by a call to\n\
9812 `x-hide-busy-cursor' to make the busy pointer disappear again.")
9816 if (busy_count
== 1)
9818 Lisp_Object rest
, frame
;
9820 FOR_EACH_FRAME (rest
, frame
)
9821 if (FRAME_X_P (XFRAME (frame
)))
9823 struct frame
*f
= XFRAME (frame
);
9826 f
->output_data
.x
->busy_p
= 1;
9828 if (!f
->output_data
.x
->busy_window
)
9830 unsigned long mask
= CWCursor
;
9831 XSetWindowAttributes attrs
;
9833 attrs
.cursor
= f
->output_data
.x
->busy_cursor
;
9835 f
->output_data
.x
->busy_window
9836 = XCreateWindow (FRAME_X_DISPLAY (f
),
9837 FRAME_OUTER_WINDOW (f
),
9838 0, 0, 32000, 32000, 0, 0,
9844 XMapRaised (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9853 DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor
,
9854 Sx_hide_busy_cursor
, 0, 1, 0,
9855 "Hide a busy-cursor.\n\
9856 A busy-cursor will actually be undisplayed when a matching\n\
9857 `x-hide-busy-cursor' is called for each `x-show-busy-cursor'\n\
9858 issued. FORCE non-nil means hide the busy-cursor forcibly,\n\
9859 not counting calls.")
9863 Lisp_Object rest
, frame
;
9865 if (busy_count
== 0)
9868 if (!NILP (force
) && busy_count
!= 0)
9872 if (busy_count
!= 0)
9875 FOR_EACH_FRAME (rest
, frame
)
9877 struct frame
*f
= XFRAME (frame
);
9880 /* Watch out for newly created frames. */
9881 && f
->output_data
.x
->busy_window
)
9885 XUnmapWindow (FRAME_X_DISPLAY (f
), f
->output_data
.x
->busy_window
);
9886 /* Sync here because XTread_socket looks at the busy_p flag
9887 that is reset to zero below. */
9888 XSync (FRAME_X_DISPLAY (f
), False
);
9890 f
->output_data
.x
->busy_p
= 0;
9899 /***********************************************************************
9901 ***********************************************************************/
9903 static Lisp_Object x_create_tip_frame
P_ ((struct x_display_info
*,
9906 /* The frame of a currently visible tooltip, or null. */
9908 struct frame
*tip_frame
;
9910 /* If non-nil, a timer started that hides the last tooltip when it
9913 Lisp_Object tip_timer
;
9916 /* Create a frame for a tooltip on the display described by DPYINFO.
9917 PARMS is a list of frame parameters. Value is the frame. */
9920 x_create_tip_frame (dpyinfo
, parms
)
9921 struct x_display_info
*dpyinfo
;
9925 Lisp_Object frame
, tem
;
9927 long window_prompting
= 0;
9929 int count
= specpdl_ptr
- specpdl
;
9930 struct gcpro gcpro1
, gcpro2
, gcpro3
;
9935 /* Use this general default value to start with until we know if
9936 this frame has a specified name. */
9937 Vx_resource_name
= Vinvocation_name
;
9940 kb
= dpyinfo
->kboard
;
9942 kb
= &the_only_kboard
;
9945 /* Get the name of the frame to use for resource lookup. */
9946 name
= x_get_arg (dpyinfo
, parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
9948 && !EQ (name
, Qunbound
)
9950 error ("Invalid frame name--not a string or nil");
9951 Vx_resource_name
= name
;
9954 GCPRO3 (parms
, name
, frame
);
9955 tip_frame
= f
= make_frame (1);
9956 XSETFRAME (frame
, f
);
9957 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
9959 f
->output_method
= output_x_window
;
9960 f
->output_data
.x
= (struct x_output
*) xmalloc (sizeof (struct x_output
));
9961 bzero (f
->output_data
.x
, sizeof (struct x_output
));
9962 f
->output_data
.x
->icon_bitmap
= -1;
9963 f
->output_data
.x
->fontset
= -1;
9964 f
->icon_name
= Qnil
;
9965 FRAME_X_DISPLAY_INFO (f
) = dpyinfo
;
9967 FRAME_KBOARD (f
) = kb
;
9969 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
9970 f
->output_data
.x
->explicit_parent
= 0;
9972 /* Set the name; the functions to which we pass f expect the name to
9974 if (EQ (name
, Qunbound
) || NILP (name
))
9976 f
->name
= build_string (dpyinfo
->x_id_name
);
9977 f
->explicit_name
= 0;
9982 f
->explicit_name
= 1;
9983 /* use the frame's title when getting resources for this frame. */
9984 specbind (Qx_resource_name
, name
);
9987 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9988 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCDR (tem
))
9989 fs_register_fontset (f
, XCAR (tem
));
9991 /* Extract the window parameters from the supplied values
9992 that are needed to determine window geometry. */
9996 font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
9999 /* First, try whatever font the caller has specified. */
10000 if (STRINGP (font
))
10002 tem
= Fquery_fontset (font
, Qnil
);
10004 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
10006 font
= x_new_font (f
, XSTRING (font
)->data
);
10009 /* Try out a font which we hope has bold and italic variations. */
10010 if (!STRINGP (font
))
10011 font
= x_new_font (f
, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10012 if (!STRINGP (font
))
10013 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10014 if (! STRINGP (font
))
10015 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10016 if (! STRINGP (font
))
10017 /* This was formerly the first thing tried, but it finds too many fonts
10018 and takes too long. */
10019 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10020 /* If those didn't work, look for something which will at least work. */
10021 if (! STRINGP (font
))
10022 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10024 if (! STRINGP (font
))
10025 font
= build_string ("fixed");
10027 x_default_parameter (f
, parms
, Qfont
, font
,
10028 "font", "Font", RES_TYPE_STRING
);
10031 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
10032 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
10034 /* This defaults to 2 in order to match xterm. We recognize either
10035 internalBorderWidth or internalBorder (which is what xterm calls
10037 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10041 value
= x_get_arg (dpyinfo
, parms
, Qinternal_border_width
,
10042 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
10043 if (! EQ (value
, Qunbound
))
10044 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
10048 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
10049 "internalBorderWidth", "internalBorderWidth",
10052 /* Also do the stuff which must be set before the window exists. */
10053 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
10054 "foreground", "Foreground", RES_TYPE_STRING
);
10055 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
10056 "background", "Background", RES_TYPE_STRING
);
10057 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
10058 "pointerColor", "Foreground", RES_TYPE_STRING
);
10059 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
10060 "cursorColor", "Foreground", RES_TYPE_STRING
);
10061 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
10062 "borderColor", "BorderColor", RES_TYPE_STRING
);
10064 /* Init faces before x_default_parameter is called for scroll-bar
10065 parameters because that function calls x_set_scroll_bar_width,
10066 which calls change_frame_size, which calls Fset_window_buffer,
10067 which runs hooks, which call Fvertical_motion. At the end, we
10068 end up in init_iterator with a null face cache, which should not
10070 init_frame_faces (f
);
10072 f
->output_data
.x
->parent_desc
= FRAME_X_DISPLAY_INFO (f
)->root_window
;
10073 window_prompting
= x_figure_window_size (f
, parms
);
10075 if (window_prompting
& XNegative
)
10077 if (window_prompting
& YNegative
)
10078 f
->output_data
.x
->win_gravity
= SouthEastGravity
;
10080 f
->output_data
.x
->win_gravity
= NorthEastGravity
;
10084 if (window_prompting
& YNegative
)
10085 f
->output_data
.x
->win_gravity
= SouthWestGravity
;
10087 f
->output_data
.x
->win_gravity
= NorthWestGravity
;
10090 f
->output_data
.x
->size_hint_flags
= window_prompting
;
10092 XSetWindowAttributes attrs
;
10093 unsigned long mask
;
10096 mask
= CWBackPixel
| CWOverrideRedirect
| CWSaveUnder
| CWEventMask
;
10097 /* Window managers looks at the override-redirect flag to
10098 determine whether or net to give windows a decoration (Xlib
10100 attrs
.override_redirect
= True
;
10101 attrs
.save_under
= True
;
10102 attrs
.background_pixel
= FRAME_BACKGROUND_PIXEL (f
);
10103 /* Arrange for getting MapNotify and UnmapNotify events. */
10104 attrs
.event_mask
= StructureNotifyMask
;
10106 = FRAME_X_WINDOW (f
)
10107 = XCreateWindow (FRAME_X_DISPLAY (f
),
10108 FRAME_X_DISPLAY_INFO (f
)->root_window
,
10109 /* x, y, width, height */
10113 CopyFromParent
, InputOutput
, CopyFromParent
,
10120 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
10121 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10122 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
10123 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
10124 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
10125 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
10127 /* Dimensions, especially f->height, must be done via change_frame_size.
10128 Change will not be effected unless different from the current
10131 height
= f
->height
;
10133 SET_FRAME_WIDTH (f
, 0);
10134 change_frame_size (f
, height
, width
, 1, 0, 0);
10140 /* It is now ok to make the frame official even if we get an error
10141 below. And the frame needs to be on Vframe_list or making it
10142 visible won't work. */
10143 Vframe_list
= Fcons (frame
, Vframe_list
);
10145 /* Now that the frame is official, it counts as a reference to
10147 FRAME_X_DISPLAY_INFO (f
)->reference_count
++;
10149 return unbind_to (count
, frame
);
10153 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 4, 0,
10154 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10155 A tooltip window is a small X window displaying STRING at\n\
10156 the current mouse position.\n\
10157 FRAME nil or omitted means use the selected frame.\n\
10158 PARMS is an optional list of frame parameters which can be\n\
10159 used to change the tooltip's appearance.\n\
10160 Automatically hide the tooltip after TIMEOUT seconds.\n\
10161 TIMEOUT nil means use the default timeout of 5 seconds.")
10162 (string
, frame
, parms
, timeout
)
10163 Lisp_Object string
, frame
, parms
, timeout
;
10167 Window root
, child
;
10168 Lisp_Object buffer
;
10169 struct buffer
*old_buffer
;
10170 struct text_pos pos
;
10171 int i
, width
, height
;
10172 int root_x
, root_y
, win_x
, win_y
;
10174 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
10175 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
10176 int count
= specpdl_ptr
- specpdl
;
10178 specbind (Qinhibit_redisplay
, Qt
);
10180 GCPRO4 (string
, parms
, frame
, timeout
);
10182 CHECK_STRING (string
, 0);
10183 f
= check_x_frame (frame
);
10184 if (NILP (timeout
))
10185 timeout
= make_number (5);
10187 CHECK_NATNUM (timeout
, 2);
10189 /* Hide a previous tip, if any. */
10192 /* Add default values to frame parameters. */
10193 if (NILP (Fassq (Qname
, parms
)))
10194 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
10195 if (NILP (Fassq (Qinternal_border_width
, parms
)))
10196 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
10197 if (NILP (Fassq (Qborder_width
, parms
)))
10198 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
10199 if (NILP (Fassq (Qborder_color
, parms
)))
10200 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
10201 if (NILP (Fassq (Qbackground_color
, parms
)))
10202 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
10205 /* Create a frame for the tooltip, and record it in the global
10206 variable tip_frame. */
10207 frame
= x_create_tip_frame (FRAME_X_DISPLAY_INFO (f
), parms
);
10208 tip_frame
= f
= XFRAME (frame
);
10210 /* Set up the frame's root window. Currently we use a size of 80
10211 columns x 40 lines. If someone wants to show a larger tip, he
10212 will loose. I don't think this is a realistic case. */
10213 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
10214 w
->left
= w
->top
= make_number (0);
10218 w
->pseudo_window_p
= 1;
10220 /* Display the tooltip text in a temporary buffer. */
10221 buffer
= Fget_buffer_create (build_string (" *tip*"));
10222 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
);
10223 old_buffer
= current_buffer
;
10224 set_buffer_internal_1 (XBUFFER (buffer
));
10226 Finsert (make_number (1), &string
);
10227 clear_glyph_matrix (w
->desired_matrix
);
10228 clear_glyph_matrix (w
->current_matrix
);
10229 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
10230 try_window (FRAME_ROOT_WINDOW (f
), pos
);
10232 /* Compute width and height of the tooltip. */
10233 width
= height
= 0;
10234 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
10236 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
10237 struct glyph
*last
;
10240 /* Stop at the first empty row at the end. */
10241 if (!row
->enabled_p
|| !row
->displays_text_p
)
10244 /* Let the row go over the full width of the frame. */
10245 row
->full_width_p
= 1;
10247 /* There's a glyph at the end of rows that is use to place
10248 the cursor there. Don't include the width of this glyph. */
10249 if (row
->used
[TEXT_AREA
])
10251 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
10252 row_width
= row
->pixel_width
- last
->pixel_width
;
10255 row_width
= row
->pixel_width
;
10257 height
+= row
->height
;
10258 width
= max (width
, row_width
);
10261 /* Add the frame's internal border to the width and height the X
10262 window should have. */
10263 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10264 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
10266 /* Move the tooltip window where the mouse pointer is. Resize and
10269 XQueryPointer (FRAME_X_DISPLAY (f
), FRAME_X_DISPLAY_INFO (f
)->root_window
,
10270 &root
, &child
, &root_x
, &root_y
, &win_x
, &win_y
, &pmask
);
10271 XMoveResizeWindow (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
10272 root_x
+ 5, root_y
- height
- 5, width
, height
);
10273 XMapRaised (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
));
10276 /* Draw into the window. */
10277 w
->must_be_updated_p
= 1;
10278 update_single_window (w
, 1);
10280 /* Restore original current buffer. */
10281 set_buffer_internal_1 (old_buffer
);
10282 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
10284 /* Let the tip disappear after timeout seconds. */
10285 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
10286 intern ("x-hide-tip"));
10289 return unbind_to (count
, Qnil
);
10293 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
10294 "Hide the current tooltip window, if there is any.\n\
10295 Value is t is tooltip was open, nil otherwise.")
10298 int count
= specpdl_ptr
- specpdl
;
10301 specbind (Qinhibit_redisplay
, Qt
);
10303 if (!NILP (tip_timer
))
10305 call1 (intern ("cancel-timer"), tip_timer
);
10313 XSETFRAME (frame
, tip_frame
);
10314 Fdelete_frame (frame
, Qt
);
10319 return unbind_to (count
, deleted_p
? Qt
: Qnil
);
10324 /***********************************************************************
10325 File selection dialog
10326 ***********************************************************************/
10330 /* Callback for "OK" and "Cancel" on file selection dialog. */
10333 file_dialog_cb (widget
, client_data
, call_data
)
10335 XtPointer call_data
, client_data
;
10337 int *result
= (int *) client_data
;
10338 XmAnyCallbackStruct
*cb
= (XmAnyCallbackStruct
*) call_data
;
10339 *result
= cb
->reason
;
10343 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 4, 0,
10344 "Read file name, prompting with PROMPT in directory DIR.\n\
10345 Use a file selection dialog.\n\
10346 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10347 specified. Don't let the user enter a file name in the file\n\
10348 selection dialog's entry field, if MUSTMATCH is non-nil.")
10349 (prompt
, dir
, default_filename
, mustmatch
)
10350 Lisp_Object prompt
, dir
, default_filename
, mustmatch
;
10353 struct frame
*f
= SELECTED_FRAME ();
10354 Lisp_Object file
= Qnil
;
10355 Widget dialog
, text
, list
, help
;
10358 extern XtAppContext Xt_app_con
;
10360 XmString dir_xmstring
, pattern_xmstring
;
10361 int popup_activated_flag
;
10362 int count
= specpdl_ptr
- specpdl
;
10363 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
10365 GCPRO5 (prompt
, dir
, default_filename
, mustmatch
, file
);
10366 CHECK_STRING (prompt
, 0);
10367 CHECK_STRING (dir
, 1);
10369 /* Prevent redisplay. */
10370 specbind (Qinhibit_redisplay
, Qt
);
10374 /* Create the dialog with PROMPT as title, using DIR as initial
10375 directory and using "*" as pattern. */
10376 dir
= Fexpand_file_name (dir
, Qnil
);
10377 dir_xmstring
= XmStringCreateLocalized (XSTRING (dir
)->data
);
10378 pattern_xmstring
= XmStringCreateLocalized ("*");
10380 XtSetArg (al
[ac
], XmNtitle
, XSTRING (prompt
)->data
); ++ac
;
10381 XtSetArg (al
[ac
], XmNdirectory
, dir_xmstring
); ++ac
;
10382 XtSetArg (al
[ac
], XmNpattern
, pattern_xmstring
); ++ac
;
10383 XtSetArg (al
[ac
], XmNresizePolicy
, XmRESIZE_GROW
); ++ac
;
10384 XtSetArg (al
[ac
], XmNdialogStyle
, XmDIALOG_APPLICATION_MODAL
); ++ac
;
10385 dialog
= XmCreateFileSelectionDialog (f
->output_data
.x
->widget
,
10387 XmStringFree (dir_xmstring
);
10388 XmStringFree (pattern_xmstring
);
10390 /* Add callbacks for OK and Cancel. */
10391 XtAddCallback (dialog
, XmNokCallback
, file_dialog_cb
,
10392 (XtPointer
) &result
);
10393 XtAddCallback (dialog
, XmNcancelCallback
, file_dialog_cb
,
10394 (XtPointer
) &result
);
10396 /* Disable the help button since we can't display help. */
10397 help
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_HELP_BUTTON
);
10398 XtSetSensitive (help
, False
);
10400 /* Mark OK button as default. */
10401 XtVaSetValues (XmFileSelectionBoxGetChild (dialog
, XmDIALOG_OK_BUTTON
),
10402 XmNshowAsDefault
, True
, NULL
);
10404 /* If MUSTMATCH is non-nil, disable the file entry field of the
10405 dialog, so that the user must select a file from the files list
10406 box. We can't remove it because we wouldn't have a way to get at
10407 the result file name, then. */
10408 text
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_TEXT
);
10409 if (!NILP (mustmatch
))
10412 label
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_SELECTION_LABEL
);
10413 XtSetSensitive (text
, False
);
10414 XtSetSensitive (label
, False
);
10417 /* Manage the dialog, so that list boxes get filled. */
10418 XtManageChild (dialog
);
10420 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10421 must include the path for this to work. */
10422 list
= XmFileSelectionBoxGetChild (dialog
, XmDIALOG_LIST
);
10423 if (STRINGP (default_filename
))
10425 XmString default_xmstring
;
10429 = XmStringCreateLocalized (XSTRING (default_filename
)->data
);
10431 if (!XmListItemExists (list
, default_xmstring
))
10433 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10434 XmListAddItem (list
, default_xmstring
, 0);
10438 item_pos
= XmListItemPos (list
, default_xmstring
);
10439 XmStringFree (default_xmstring
);
10441 /* Select the item and scroll it into view. */
10442 XmListSelectPos (list
, item_pos
, True
);
10443 XmListSetPos (list
, item_pos
);
10446 /* Process all events until the user presses Cancel or OK. */
10447 for (result
= 0; result
== 0;)
10450 Widget widget
, parent
;
10452 XtAppNextEvent (Xt_app_con
, &event
);
10454 /* See if the receiver of the event is one of the widgets of
10455 the file selection dialog. If so, dispatch it. If not,
10457 widget
= XtWindowToWidget (event
.xany
.display
, event
.xany
.window
);
10459 while (parent
&& parent
!= dialog
)
10460 parent
= XtParent (parent
);
10462 if (parent
== dialog
10463 || (event
.type
== Expose
10464 && !process_expose_from_menu (event
)))
10465 XtDispatchEvent (&event
);
10468 /* Get the result. */
10469 if (result
== XmCR_OK
)
10474 XtVaGetValues (dialog
, XmNtextString
, &text
, 0);
10475 XmStringGetLtoR (text
, XmFONTLIST_DEFAULT_TAG
, &data
);
10476 XmStringFree (text
);
10477 file
= build_string (data
);
10484 XtUnmanageChild (dialog
);
10485 XtDestroyWidget (dialog
);
10489 /* Make "Cancel" equivalent to C-g. */
10491 Fsignal (Qquit
, Qnil
);
10493 return unbind_to (count
, file
);
10496 #endif /* USE_MOTIF */
10499 /***********************************************************************
10501 ***********************************************************************/
10505 DEFUN ("imagep", Fimagep
, Simagep
, 1, 1, 0,
10506 "Value is non-nil if SPEC is a valid image specification.")
10510 return valid_image_p (spec
) ? Qt
: Qnil
;
10514 DEFUN ("lookup-image", Flookup_image
, Slookup_image
, 1, 1, 0, "")
10520 if (valid_image_p (spec
))
10521 id
= lookup_image (SELECTED_FRAME (), spec
);
10523 debug_print (spec
);
10524 return make_number (id
);
10527 #endif /* GLYPH_DEBUG != 0 */
10531 /***********************************************************************
10533 ***********************************************************************/
10538 /* This is zero if not using X windows. */
10541 /* The section below is built by the lisp expression at the top of the file,
10542 just above where these variables are declared. */
10543 /*&&& init symbols here &&&*/
10544 Qauto_raise
= intern ("auto-raise");
10545 staticpro (&Qauto_raise
);
10546 Qauto_lower
= intern ("auto-lower");
10547 staticpro (&Qauto_lower
);
10548 Qbar
= intern ("bar");
10550 Qborder_color
= intern ("border-color");
10551 staticpro (&Qborder_color
);
10552 Qborder_width
= intern ("border-width");
10553 staticpro (&Qborder_width
);
10554 Qbox
= intern ("box");
10556 Qcursor_color
= intern ("cursor-color");
10557 staticpro (&Qcursor_color
);
10558 Qcursor_type
= intern ("cursor-type");
10559 staticpro (&Qcursor_type
);
10560 Qgeometry
= intern ("geometry");
10561 staticpro (&Qgeometry
);
10562 Qicon_left
= intern ("icon-left");
10563 staticpro (&Qicon_left
);
10564 Qicon_top
= intern ("icon-top");
10565 staticpro (&Qicon_top
);
10566 Qicon_type
= intern ("icon-type");
10567 staticpro (&Qicon_type
);
10568 Qicon_name
= intern ("icon-name");
10569 staticpro (&Qicon_name
);
10570 Qinternal_border_width
= intern ("internal-border-width");
10571 staticpro (&Qinternal_border_width
);
10572 Qleft
= intern ("left");
10573 staticpro (&Qleft
);
10574 Qright
= intern ("right");
10575 staticpro (&Qright
);
10576 Qmouse_color
= intern ("mouse-color");
10577 staticpro (&Qmouse_color
);
10578 Qnone
= intern ("none");
10579 staticpro (&Qnone
);
10580 Qparent_id
= intern ("parent-id");
10581 staticpro (&Qparent_id
);
10582 Qscroll_bar_width
= intern ("scroll-bar-width");
10583 staticpro (&Qscroll_bar_width
);
10584 Qsuppress_icon
= intern ("suppress-icon");
10585 staticpro (&Qsuppress_icon
);
10586 Qundefined_color
= intern ("undefined-color");
10587 staticpro (&Qundefined_color
);
10588 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
10589 staticpro (&Qvertical_scroll_bars
);
10590 Qvisibility
= intern ("visibility");
10591 staticpro (&Qvisibility
);
10592 Qwindow_id
= intern ("window-id");
10593 staticpro (&Qwindow_id
);
10594 Qouter_window_id
= intern ("outer-window-id");
10595 staticpro (&Qouter_window_id
);
10596 Qx_frame_parameter
= intern ("x-frame-parameter");
10597 staticpro (&Qx_frame_parameter
);
10598 Qx_resource_name
= intern ("x-resource-name");
10599 staticpro (&Qx_resource_name
);
10600 Quser_position
= intern ("user-position");
10601 staticpro (&Quser_position
);
10602 Quser_size
= intern ("user-size");
10603 staticpro (&Quser_size
);
10604 Qscroll_bar_foreground
= intern ("scroll-bar-foreground");
10605 staticpro (&Qscroll_bar_foreground
);
10606 Qscroll_bar_background
= intern ("scroll-bar-background");
10607 staticpro (&Qscroll_bar_background
);
10608 Qscreen_gamma
= intern ("screen-gamma");
10609 staticpro (&Qscreen_gamma
);
10610 /* This is the end of symbol initialization. */
10612 /* Text property `display' should be nonsticky by default. */
10613 Vtext_property_default_nonsticky
10614 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
10617 Qlaplace
= intern ("laplace");
10618 staticpro (&Qlaplace
);
10620 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
10621 staticpro (&Qface_set_after_frame_default
);
10623 Fput (Qundefined_color
, Qerror_conditions
,
10624 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
10625 Fput (Qundefined_color
, Qerror_message
,
10626 build_string ("Undefined color"));
10628 init_x_parm_symbols ();
10630 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
10631 "List of directories to search for bitmap files for X.");
10632 Vx_bitmap_file_path
= decode_env_path ((char *) 0, PATH_BITMAPS
);
10634 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
10635 "The shape of the pointer when over text.\n\
10636 Changing the value does not affect existing frames\n\
10637 unless you set the mouse color.");
10638 Vx_pointer_shape
= Qnil
;
10640 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
10641 "The name Emacs uses to look up X resources.\n\
10642 `x-get-resource' uses this as the first component of the instance name\n\
10643 when requesting resource values.\n\
10644 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10645 was invoked, or to the value specified with the `-name' or `-rn'\n\
10646 switches, if present.\n\
10648 It may be useful to bind this variable locally around a call\n\
10649 to `x-get-resource'. See also the variable `x-resource-class'.");
10650 Vx_resource_name
= Qnil
;
10652 DEFVAR_LISP ("x-resource-class", &Vx_resource_class
,
10653 "The class Emacs uses to look up X resources.\n\
10654 `x-get-resource' uses this as the first component of the instance class\n\
10655 when requesting resource values.\n\
10656 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10658 Setting this variable permanently is not a reasonable thing to do,\n\
10659 but binding this variable locally around a call to `x-get-resource'\n\
10660 is a reasonable practice. See also the variable `x-resource-name'.");
10661 Vx_resource_class
= build_string (EMACS_CLASS
);
10663 #if 0 /* This doesn't really do anything. */
10664 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape
,
10665 "The shape of the pointer when not over text.\n\
10666 This variable takes effect when you create a new frame\n\
10667 or when you set the mouse color.");
10669 Vx_nontext_pointer_shape
= Qnil
;
10671 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape
,
10672 "The shape of the pointer when Emacs is busy.\n\
10673 This variable takes effect when you create a new frame\n\
10674 or when you set the mouse color.");
10675 Vx_busy_pointer_shape
= Qnil
;
10677 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p
,
10678 "Non-zero means Emacs displays a busy cursor on window systems.");
10679 display_busy_cursor_p
= 1;
10681 #if 0 /* This doesn't really do anything. */
10682 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape
,
10683 "The shape of the pointer when over the mode line.\n\
10684 This variable takes effect when you create a new frame\n\
10685 or when you set the mouse color.");
10687 Vx_mode_pointer_shape
= Qnil
;
10689 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
10690 &Vx_sensitive_text_pointer_shape
,
10691 "The shape of the pointer when over mouse-sensitive text.\n\
10692 This variable takes effect when you create a new frame\n\
10693 or when you set the mouse color.");
10694 Vx_sensitive_text_pointer_shape
= Qnil
;
10696 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
10697 "A string indicating the foreground color of the cursor box.");
10698 Vx_cursor_fore_pixel
= Qnil
;
10700 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
10701 "Non-nil if no X window manager is in use.\n\
10702 Emacs doesn't try to figure this out; this is always nil\n\
10703 unless you set it to something else.");
10704 /* We don't have any way to find this out, so set it to nil
10705 and maybe the user would like to set it to t. */
10706 Vx_no_window_manager
= Qnil
;
10708 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
10709 &Vx_pixel_size_width_font_regexp
,
10710 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
10712 Since Emacs gets width of a font matching with this regexp from\n\
10713 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
10714 such a font. This is especially effective for such large fonts as\n\
10715 Chinese, Japanese, and Korean.");
10716 Vx_pixel_size_width_font_regexp
= Qnil
;
10718 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay
,
10719 "Time after which cached images are removed from the cache.\n\
10720 When an image has not been displayed this many seconds, remove it\n\
10721 from the image cache. Value must be an integer or nil with nil\n\
10722 meaning don't clear the cache.");
10723 Vimage_cache_eviction_delay
= make_number (30 * 60);
10725 DEFVAR_LISP ("image-types", &Vimage_types
,
10726 "List of supported image types.\n\
10727 Each element of the list is a symbol for a supported image type.");
10728 Vimage_types
= Qnil
;
10730 #ifdef USE_X_TOOLKIT
10731 Fprovide (intern ("x-toolkit"));
10734 Fprovide (intern ("motif"));
10737 defsubr (&Sx_get_resource
);
10739 /* X window properties. */
10740 defsubr (&Sx_change_window_property
);
10741 defsubr (&Sx_delete_window_property
);
10742 defsubr (&Sx_window_property
);
10745 defsubr (&Sx_draw_rectangle
);
10746 defsubr (&Sx_erase_rectangle
);
10747 defsubr (&Sx_contour_region
);
10748 defsubr (&Sx_uncontour_region
);
10750 defsubr (&Sxw_display_color_p
);
10751 defsubr (&Sx_display_grayscale_p
);
10752 defsubr (&Sxw_color_defined_p
);
10753 defsubr (&Sxw_color_values
);
10754 defsubr (&Sx_server_max_request_size
);
10755 defsubr (&Sx_server_vendor
);
10756 defsubr (&Sx_server_version
);
10757 defsubr (&Sx_display_pixel_width
);
10758 defsubr (&Sx_display_pixel_height
);
10759 defsubr (&Sx_display_mm_width
);
10760 defsubr (&Sx_display_mm_height
);
10761 defsubr (&Sx_display_screens
);
10762 defsubr (&Sx_display_planes
);
10763 defsubr (&Sx_display_color_cells
);
10764 defsubr (&Sx_display_visual_class
);
10765 defsubr (&Sx_display_backing_store
);
10766 defsubr (&Sx_display_save_under
);
10768 defsubr (&Sx_rebind_key
);
10769 defsubr (&Sx_rebind_keys
);
10770 defsubr (&Sx_track_pointer
);
10771 defsubr (&Sx_grab_pointer
);
10772 defsubr (&Sx_ungrab_pointer
);
10774 defsubr (&Sx_parse_geometry
);
10775 defsubr (&Sx_create_frame
);
10777 defsubr (&Sx_horizontal_line
);
10779 defsubr (&Sx_open_connection
);
10780 defsubr (&Sx_close_connection
);
10781 defsubr (&Sx_display_list
);
10782 defsubr (&Sx_synchronize
);
10784 /* Setting callback functions for fontset handler. */
10785 get_font_info_func
= x_get_font_info
;
10787 #if 0 /* This function pointer doesn't seem to be used anywhere.
10788 And the pointer assigned has the wrong type, anyway. */
10789 list_fonts_func
= x_list_fonts
;
10792 load_font_func
= x_load_font
;
10793 find_ccl_program_func
= x_find_ccl_program
;
10794 query_font_func
= x_query_font
;
10795 set_frame_fontset_func
= x_set_font
;
10796 check_window_system_func
= check_x
;
10799 Qxbm
= intern ("xbm");
10801 QCtype
= intern (":type");
10802 staticpro (&QCtype
);
10803 QCalgorithm
= intern (":algorithm");
10804 staticpro (&QCalgorithm
);
10805 QCheuristic_mask
= intern (":heuristic-mask");
10806 staticpro (&QCheuristic_mask
);
10807 QCcolor_symbols
= intern (":color-symbols");
10808 staticpro (&QCcolor_symbols
);
10809 QCdata
= intern (":data");
10810 staticpro (&QCdata
);
10811 QCascent
= intern (":ascent");
10812 staticpro (&QCascent
);
10813 QCmargin
= intern (":margin");
10814 staticpro (&QCmargin
);
10815 QCrelief
= intern (":relief");
10816 staticpro (&QCrelief
);
10817 Qpostscript
= intern ("postscript");
10818 staticpro (&Qpostscript
);
10819 QCloader
= intern (":loader");
10820 staticpro (&QCloader
);
10821 QCbounding_box
= intern (":bounding-box");
10822 staticpro (&QCbounding_box
);
10823 QCpt_width
= intern (":pt-width");
10824 staticpro (&QCpt_width
);
10825 QCpt_height
= intern (":pt-height");
10826 staticpro (&QCpt_height
);
10827 QCindex
= intern (":index");
10828 staticpro (&QCindex
);
10829 Qpbm
= intern ("pbm");
10833 Qxpm
= intern ("xpm");
10838 Qjpeg
= intern ("jpeg");
10839 staticpro (&Qjpeg
);
10843 Qtiff
= intern ("tiff");
10844 staticpro (&Qtiff
);
10848 Qgif
= intern ("gif");
10853 Qpng
= intern ("png");
10857 defsubr (&Sclear_image_cache
);
10860 defsubr (&Simagep
);
10861 defsubr (&Slookup_image
);
10865 defsubr (&Sx_show_busy_cursor
);
10866 defsubr (&Sx_hide_busy_cursor
);
10868 inhibit_busy_cursor
= 0;
10870 defsubr (&Sx_show_tip
);
10871 defsubr (&Sx_hide_tip
);
10872 staticpro (&tip_timer
);
10876 defsubr (&Sx_file_dialog
);
10884 image_types
= NULL
;
10885 Vimage_types
= Qnil
;
10887 define_image_type (&xbm_type
);
10888 define_image_type (&gs_type
);
10889 define_image_type (&pbm_type
);
10892 define_image_type (&xpm_type
);
10896 define_image_type (&jpeg_type
);
10900 define_image_type (&tiff_type
);
10904 define_image_type (&gif_type
);
10908 define_image_type (&png_type
);
10912 #endif /* HAVE_X_WINDOWS */